Link to home
Start Free TrialLog in
Avatar of sviksna
sviksna

asked on

the image color depth

hello... i have made counter in cgi..
bet the problem is that, i can't set smaller size for images

the code is
..............................
unit cgi_images;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, ExtCtrls, Jpeg, Graphics, Inifiles, Forms;

type
  TWebModule1 = class(TWebModule)
    PageProducer1: TPageProducer;
    procedure WebModule1WebActionItem1Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

implementation

{$R *.DFM}


procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);

var Stream: TMemoryStream;
    Pic : TImage;
begin

{ create stream }
  Stream := TMemoryStream.Create;

{ making picture}
  Pic := TImage.Create(self);
  Pic.Width := 60;
  Pic.Height := 16;

  Pic.Canvas.Font.Color := clBlack;
//Pic.Picture.Bitmap.PixelFormat
  Pic.Canvas.TextOut(2,2,'ok 123..');
  Pic.Picture.Graphic.SaveToStream(stream);

{ Sending image }
  Response.ContentType := 'image/gif';
  Stream.Position := 0;
  Response.ContentStream := Stream;
  Response.SendResponse;

{ Handled := True;}
  Stream.Free;

end;


end.


..........
ie triedo to do something with
Pic.Picture.Bitmap.PixelFormat

but no success:((
please, help me.
Sandis.
Avatar of Radler
Radler
Hi sviksna,

Here is a complete code( auh ! by 50 points !!) .
At your code a Graphic <> Gif data, if really desired a gif image replace the TJPEGImage to TGifImage class below.

Some methods must be ignored, because they are inside Reg32 and/or Str_Pas, but your names are sugests.

T++, Radler.

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, Graphics, JPeg, Math;

type
  TMainWebMod = class(TWebModule)
       procedure MainWebModSendNumImgAction( Sender: TObject; Request: TWebRequest; Response: TWebResponse;
                                                               var Handled: Boolean);
       procedure WebModuleAfterDispatch( Sender: TObject; Request: TWebRequest; Response: TWebResponse;
                                                         var Handled: Boolean);
  private
       { Private declarations }
       Strm : TMemoryStream;
       function ProcessCountID( CounterName : string) : integer;
       procedure SetErrorImage(const Value: string);
       function GetErrorImage: string;
       procedure SetCountValue( const CountName : string; Value : integer );
  public
       { Public declarations }
       property ErrorImage : string read GetErrorImage write SetErrorImage;
       procedure LoadImgNames( Num : integer; const RootDir : string; List : TStringList ); //Cria lista da arquvos para serem carregados
       procedure MountJPGImage( List : TStringList; OutImg : TBitMap );
       procedure GetNumberImg( Num : integer; OutImg : TJPEGImage );
       procedure SendErrorImg( Response : TWebResponse );
  end;

var
  MainWebMod: TMainWebMod;

implementation

{$R *.DFM}

uses
      Str_Pas, Reg32;


const
      _REG_PATH_            =      'HKEY_LOCAL_MACHINE\Software\ARS\Roger\WebCounter';
      _DEF_ERROR_IMG_      =      'V:\Paginas HTML\contador\ERROR.JPG' ;

procedure TMainWebMod.GetNumberImg(Num: integer; OutImg : TJPEGImage);
{-------------------------------------------------------------------------------------------------------------}
var
      List : TStringList;
      IBmp : TBitMap;
begin
      List:=TStringList.Create;
      IBmp:=TBitMap.Create;
      try
            Self.LoadImgNames( Num, 'V:\Paginas HTML\contador\', List );
            Self.MountJPGImage( List, IBmp );
            OutImg.Assign( IBmp );
      finally
            List.Free;
            IBmp.Free;
      end;
end;

procedure TMainWebMod.LoadImgNames(Num: integer; const RootDir: string; List: TStringList);
{-------------------------------------------------------------------------------------------------------------}
//Cria lista da arquvos para serem carregados
var
      Rest, Calc : integer;
begin
      List.Clear;
      Calc:=Num;
      repeat
            Rest:=Calc mod 10;
            Calc:=Calc div 10;
            List.Add( Rootdir + 'n' + IntToStr( Rest ) + '.jpg' );
      until Calc = 0;
end;

procedure TMainWebMod.MountJPGImage(List: TStringList; OutImg: TBitMap);
{-------------------------------------------------------------------------------------------------------------}
var
      TmpBmp : TBitMap;
      TmpImg : TJPEGImage;
      Rc : TRect;
      MaxH, AccW, i : integer;
      Ofx : integer;
begin
      i:=0;
      MaxH:=0;
      AccW:=0;

      //Carrega todas as imagens e calcula dimensoes
      TmpImg:=TJPEGImage.Create; //Figura de carga
      repeat
            try
                  TmpBmp:=TBitMap.Create; //Figura de transferencia
                  TmpImg.LoadFromFile( List.Strings[i] );
                  TmpBmp.Assign( TmpImg );
                  List.Objects[i]:=TmpBmp; //Salva imagem
                  MaxH:=Max(TmpBmp.Height, MaxH );
                  Inc( AccW , TmpBmp.Width );
            except
                  List.Delete(i);
                  System.Continue;
            end;
            Inc( i );
      until (i >= List.Count);
      TmpImg.Free;

      //Transfere imagens para saida
      OutImg.Width:=AccW;
      OutImg.Height:=MaxH;
      OfX:=OutImg.Width;
      for i:=0 to (List.Count-1) do begin
            try
                  Rc:=Rect(Ofx - TBitMap(List.Objects[i]).Width,0, Ofx,OutImg.Height );
                  OutImg.Canvas.CopyRect( Rc, TBitMap(List.Objects[i]).Canvas, TBitMap(List.Objects[i]).Canvas.ClipRect );
            except
                  //Nada
            end;
            Dec( Ofx, TBitMap(List.Objects[i]).Width);
      end;
      //Liberar objetos da lista de nomes / imagens
      for i:=List.Count-1 downto 0 do begin
            TBitMap(List.Objects[i]).Free; //Libera imagem
      end;
end;

procedure TMainWebMod.MainWebModSendNumImgAction( Sender: TObject; Request: TWebRequest; Response: TWebResponse;
                                                                           var Handled: Boolean);
{-------------------------------------------------------------------------------------------------------------}
var
      CountID : integer;
      Img : TJPEGImage;
      CounterName : string;
begin
      try
            //Pega nome do contador
            CounterName:=Request.QueryFields.Values[ 'countername' ];
            if CounterName = EmptyStr then begin
                  SendErrorImg( Response );
                  Exit;
            end;

            //Checa se ha setvalue ##alteraca do valor
            if Request.QueryFields.Values[ 'set' ] <> EmptyStr then begin
                  try
                        CountID:=StrToInt( Request.QueryFields.Values[ 'set' ] );
                  except
                        SendErrorImg( Response );
                        Exit; //Cancela atualizacao
                  end;
                  Self.SetCountValue( CounterName , CountID )
            end;

            //Pega valor apos ter incrementado anterior
            CountID:=ProcessCountID( CounterName );
            if CountID <> 0 then begin
                  Img:=TJPEGImage.Create;
                  try
                        Self.GetNumberImg( CountId, Img );
                        Strm:=TMemoryStream.Create;
                        try
                              Img.SaveToStream( Strm );
                              Strm.Position:=0;
                              Response.ContentType:='image/jpeg';
                              Response.ContentStream:=Strm;
                              Response.SendResponse;
                        finally
                              //Nao liberar o streamer aqui isso sera feito apos dispatch !!!!!!!!!!!!!
                        end;
                  finally
                        Img.Free;
                  end;
            end else begin
                  //Falha no processo deve ser informada com grafico correlato
                  Self.SendErrorImg( Response );
            end;
      finally
            Handled:=True;
      end;
end;

function TMainWebMod.ProcessCountID( CounterName : string): integer;
{-------------------------------------------------------------------------------------------------------------}
var
      Reg : TRegistryNT;
begin
      Reg:=TRegistryNT.Create;
      try
            Reg.LazyWrite:=False;
            try
                  if not Reg.ReadFullInteger(_REG_PATH_ + '\'+ CounterName, Result) then begin
                        Result:=0;
                        Reg.WriteFullInteger(_REG_PATH_ + '\'+ CounterName, Result, True );
                  end;
            except
                  Result:=0;
                  Reg.WriteFullInteger(_REG_PATH_ + '\' + CounterName, Result, True );
            end;
            Inc( Result );
            Reg.WriteFullInteger(_REG_PATH_ + '\'+ CounterName, Result, True );
      finally
            Reg.Free;
      end;
end;

procedure TMainWebMod.SendErrorImg(Response: TWebResponse);
{-------------------------------------------------------------------------------------------------------------}
var
      BufferImg : TJpegImage;
begin
      BufferImg:=TJPEGImage.Create;
      try
            BufferImg.LoadFromfile( ErrorImage ); //Carrega imagem de erro
            try
                  BufferImg.SaveToStream( Strm );
                  Strm.Position:=0;
                  Response.ContentType := 'image/jpeg';
                  Response.ContentStream := Strm;
                  Response.SendResponse;
            finally
                  //!!!!! Nao liberar o streamer para processo apos finalizar dispacho
            end;
      finally
            BufferImg.Free;
      end;
end;

procedure TMainWebMod.SetErrorImage(const Value: string);
{-------------------------------------------------------------------------------------------------------------}
var
      Reg : TRegistryNT;
begin
      Reg:=TRegistryNT.Create;
      try
            Reg.WriteFullString( _REG_PATH_ + '\'+ 'ErrorImage', Value, True );
      finally
            Reg.Free;
      end;
end;

function TMainWebMod.GetErrorImage: string;
{-------------------------------------------------------------------------------------------------------------}
var
      Reg : TRegistryNT;
begin
      Reg:=TRegistryNT.Create;
      try
            try
                  Reg.ReadFullString( _REG_PATH_ + 'ErrorImage', Result );
            except
                  Reg.WriteFullString( _REG_PATH_ + 'ErrorImage', _DEF_ERROR_IMG_, True );
            end;
      finally
            Reg.Free;
      end;
end;

procedure TMainWebMod.SetCountValue(const CountName: string; Value: integer);
{-------------------------------------------------------------------------------------------------------------}
var
      Reg : TRegistryNT;
begin
      Reg:=TRegistryNT.Create;
      try
            Reg.OpenFullKey( _REG_PATH_, True );
            Reg.WriteInteger( CountName , Value );
      finally
            Reg.Free;
      end;
end;

procedure TMainWebMod.WebModuleAfterDispatch( Sender: TObject; Request: TWebRequest; Response: TWebResponse;
                                                                     var Handled: Boolean);
{-------------------------------------------------------------------------------------------------------------}
begin
      if Assigned( Strm ) then begin
            Strm.Free;
      end;
end;

end.
Avatar of Radler
Radler
Hi sviksna,

Here is a complete code( auh ! by 50 points !!) .
At your code a Graphic <> Gif data, if really desired a gif image replace the TJPEGImage to TGifImage class below.

Some methods must be ignored, because they are inside Reg32 and/or Str_Pas, but your names are sugests.

T++, Radler.

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, Graphics, JPeg, Math;

type
  TMainWebMod = class(TWebModule)
       procedure MainWebModSendNumImgAction( Sender: TObject; Request: TWebRequest; Response: TWebResponse;
                                                               var Handled: Boolean);
       procedure WebModuleAfterDispatch( Sender: TObject; Request: TWebRequest; Response: TWebResponse;
                                                         var Handled: Boolean);
  private
       { Private declarations }
       Strm : TMemoryStream;
       function ProcessCountID( CounterName : string) : integer;
       procedure SetErrorImage(const Value: string);
       function GetErrorImage: string;
       procedure SetCountValue( const CountName : string; Value : integer );
  public
       { Public declarations }
       property ErrorImage : string read GetErrorImage write SetErrorImage;
       procedure LoadImgNames( Num : integer; const RootDir : string; List : TStringList ); //Cria lista da arquvos para serem carregados
       procedure MountJPGImage( List : TStringList; OutImg : TBitMap );
       procedure GetNumberImg( Num : integer; OutImg : TJPEGImage );
       procedure SendErrorImg( Response : TWebResponse );
  end;

var
  MainWebMod: TMainWebMod;

implementation

{$R *.DFM}

uses
      Str_Pas, Reg32;


const
      _REG_PATH_            =      'HKEY_LOCAL_MACHINE\Software\ARS\Roger\WebCounter';
      _DEF_ERROR_IMG_      =      'V:\Paginas HTML\contador\ERROR.JPG' ;

procedure TMainWebMod.GetNumberImg(Num: integer; OutImg : TJPEGImage);
{-------------------------------------------------------------------------------------------------------------}
var
      List : TStringList;
      IBmp : TBitMap;
begin
      List:=TStringList.Create;
      IBmp:=TBitMap.Create;
      try
            Self.LoadImgNames( Num, 'V:\Paginas HTML\contador\', List );
            Self.MountJPGImage( List, IBmp );
            OutImg.Assign( IBmp );
      finally
            List.Free;
            IBmp.Free;
      end;
end;

procedure TMainWebMod.LoadImgNames(Num: integer; const RootDir: string; List: TStringList);
{-------------------------------------------------------------------------------------------------------------}
//Cria lista da arquvos para serem carregados
var
      Rest, Calc : integer;
begin
      List.Clear;
      Calc:=Num;
      repeat
            Rest:=Calc mod 10;
            Calc:=Calc div 10;
            List.Add( Rootdir + 'n' + IntToStr( Rest ) + '.jpg' );
      until Calc = 0;
end;

procedure TMainWebMod.MountJPGImage(List: TStringList; OutImg: TBitMap);
{-------------------------------------------------------------------------------------------------------------}
var
      TmpBmp : TBitMap;
      TmpImg : TJPEGImage;
      Rc : TRect;
      MaxH, AccW, i : integer;
      Ofx : integer;
begin
      i:=0;
      MaxH:=0;
      AccW:=0;

      //Carrega todas as imagens e calcula dimensoes
      TmpImg:=TJPEGImage.Create; //Figura de carga
      repeat
            try
                  TmpBmp:=TBitMap.Create; //Figura de transferencia
                  TmpImg.LoadFromFile( List.Strings[i] );
                  TmpBmp.Assign( TmpImg );
                  List.Objects[i]:=TmpBmp; //Salva imagem
                  MaxH:=Max(TmpBmp.Height, MaxH );
                  Inc( AccW , TmpBmp.Width );
            except
                  List.Delete(i);
                  System.Continue;
            end;
            Inc( i );
      until (i >= List.Count);
      TmpImg.Free;

      //Transfere imagens para saida
      OutImg.Width:=AccW;
      OutImg.Height:=MaxH;
      OfX:=OutImg.Width;
      for i:=0 to (List.Count-1) do begin
            try
                  Rc:=Rect(Ofx - TBitMap(List.Objects[i]).Width,0, Ofx,OutImg.Height );
                  OutImg.Canvas.CopyRect( Rc, TBitMap(List.Objects[i]).Canvas, TBitMap(List.Objects[i]).Canvas.ClipRect );
            except
                  //Nada
            end;
            Dec( Ofx, TBitMap(List.Objects[i]).Width);
      end;
      //Liberar objetos da lista de nomes / imagens
      for i:=List.Count-1 downto 0 do begin
            TBitMap(List.Objects[i]).Free; //Libera imagem
      end;
end;

procedure TMainWebMod.MainWebModSendNumImgAction( Sender: TObject; Request: TWebRequest; Response: TWebResponse;
                                                                           var Handled: Boolean);
{-------------------------------------------------------------------------------------------------------------}
var
      CountID : integer;
      Img : TJPEGImage;
      CounterName : string;
begin
      try
            //Pega nome do contador
            CounterName:=Request.QueryFields.Values[ 'countername' ];
            if CounterName = EmptyStr then begin
                  SendErrorImg( Response );
                  Exit;
            end;

            //Checa se ha setvalue ##alteraca do valor
            if Request.QueryFields.Values[ 'set' ] <> EmptyStr then begin
                  try
                        CountID:=StrToInt( Request.QueryFields.Values[ 'set' ] );
                  except
                        SendErrorImg( Response );
                        Exit; //Cancela atualizacao
                  end;
                  Self.SetCountValue( CounterName , CountID )
            end;

            //Pega valor apos ter incrementado anterior
            CountID:=ProcessCountID( CounterName );
            if CountID <> 0 then begin
                  Img:=TJPEGImage.Create;
                  try
                        Self.GetNumberImg( CountId, Img );
                        Strm:=TMemoryStream.Create;
                        try
                              Img.SaveToStream( Strm );
                              Strm.Position:=0;
                              Response.ContentType:='image/jpeg';
                              Response.ContentStream:=Strm;
                              Response.SendResponse;
                        finally
                              //Nao liberar o streamer aqui isso sera feito apos dispatch !!!!!!!!!!!!!
                        end;
                  finally
                        Img.Free;
                  end;
            end else begin
                  //Falha no processo deve ser informada com grafico correlato
                  Self.SendErrorImg( Response );
            end;
      finally
            Handled:=True;
      end;
end;

function TMainWebMod.ProcessCountID( CounterName : string): integer;
{-------------------------------------------------------------------------------------------------------------}
var
      Reg : TRegistryNT;
begin
      Reg:=TRegistryNT.Create;
      try
            Reg.LazyWrite:=False;
            try
                  if not Reg.ReadFullInteger(_REG_PATH_ + '\'+ CounterName, Result) then begin
                        Result:=0;
                        Reg.WriteFullInteger(_REG_PATH_ + '\'+ CounterName, Result, True );
                  end;
            except
                  Result:=0;
                  Reg.WriteFullInteger(_REG_PATH_ + '\' + CounterName, Result, True );
            end;
            Inc( Result );
            Reg.WriteFullInteger(_REG_PATH_ + '\'+ CounterName, Result, True );
      finally
            Reg.Free;
      end;
end;

procedure TMainWebMod.SendErrorImg(Response: TWebResponse);
{-------------------------------------------------------------------------------------------------------------}
var
      BufferImg : TJpegImage;
begin
      BufferImg:=TJPEGImage.Create;
      try
            BufferImg.LoadFromfile( ErrorImage ); //Carrega imagem de erro
            try
                  BufferImg.SaveToStream( Strm );
                  Strm.Position:=0;
                  Response.ContentType := 'image/jpeg';
                  Response.ContentStream := Strm;
                  Response.SendResponse;
            finally
                  //!!!!! Nao liberar o streamer para processo apos finalizar dispacho
            end;
      finally
            BufferImg.Free;
      end;
end;

procedure TMainWebMod.SetErrorImage(const Value: string);
{-------------------------------------------------------------------------------------------------------------}
var
      Reg : TRegistryNT;
begin
      Reg:=TRegistryNT.Create;
      try
            Reg.WriteFullString( _REG_PATH_ + '\'+ 'ErrorImage', Value, True );
      finally
            Reg.Free;
      end;
end;

function TMainWebMod.GetErrorImage: string;
{-------------------------------------------------------------------------------------------------------------}
var
      Reg : TRegistryNT;
begin
      Reg:=TRegistryNT.Create;
      try
            try
                  Reg.ReadFullString( _REG_PATH_ + 'ErrorImage', Result );
            except
                  Reg.WriteFullString( _REG_PATH_ + 'ErrorImage', _DEF_ERROR_IMG_, True );
            end;
      finally
            Reg.Free;
      end;
end;

procedure TMainWebMod.SetCountValue(const CountName: string; Value: integer);
{-------------------------------------------------------------------------------------------------------------}
var
      Reg : TRegistryNT;
begin
      Reg:=TRegistryNT.Create;
      try
            Reg.OpenFullKey( _REG_PATH_, True );
            Reg.WriteInteger( CountName , Value );
      finally
            Reg.Free;
      end;
end;

procedure TMainWebMod.WebModuleAfterDispatch( Sender: TObject; Request: TWebRequest; Response: TWebResponse;
                                                                     var Handled: Boolean);
{-------------------------------------------------------------------------------------------------------------}
begin
      if Assigned( Strm ) then begin
            Strm.Free;
      end;
end;

end.
Avatar of sviksna
sviksna

ASKER

Sorry,
Are u telling me that there is source for counter, but u can't offer nothing better than Tjpeg image? (I already had it... i just wanted to set colors from 16bit to some lover number, for sample 256 or 16. That was my point, not the rutine how to build counter trought registry or INI files or Databases... i was asking for methods, how to get more smaler image in size image )


so?!?
Avatar of sviksna
sviksna

ASKER

Sorry,
Are u telling me that there is source for counter, but u can't offer nothing better than Tjpeg image? (I already had it... i just wanted to set colors from 16bit to some lover number, for sample 256 or 16. That was my point, not the rutine how to build counter trought registry or INI files or Databases... i was asking for methods, how to get more smaler image in size image )


so?!?
ASKER CERTIFIED SOLUTION
Avatar of Radler
Radler
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of sviksna
sviksna

ASKER

Ok. Thnx.