Re: [delphi-br] Trabalhar com imagem no delphi

[Desenvolvimento \(Anderson\)]

Geito não tem não...
mas Jeito tem!

é assim:


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
jpeg,
  StdCtrls, FileCtrl, ExtCtrls, ExtDlgs, Buttons, ComCtrls;
type
  PixArray = Array [0..2] of Byte;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure Antialiasing(Bitmap: TBitmap; Rect: TRect; Percent: Integer; 
NomeArquivo : String);
var
  pix, prevscan, nextscan, hpix: ^PixArray;
  l, p: Integer;
  R, G, B: Integer;
  R1, R2, G1, G2, B1, B2: Byte;
begin
  Bitmap.PixelFormat := pf24bit;
  with Bitmap.Canvas do
  begin
    Brush.Style := bsclear;
    for l := Rect.Top to Rect.Bottom - 1 do
    begin
      pix:= Bitmap.ScanLine[l];
      if l <> Rect.Top then prevscan := Bitmap.ScanLine[l-1]
      else prevscan := nil;
      if l <> Rect.Bottom - 1 then nextscan := Bitmap.ScanLine[l+1]
      else nextscan := nil;

      for p := Rect.Left to Rect.Right - 1 do begin
        R1 := pix^[2];
        G1 := pix^[1];
        B1 := pix^[0];

        if p <> Rect.Left then begin
          //Pixel links
          //Pixel left

          hpix := pix;
          dec(hpix);
          R2 := hpix^[2];
          G2 := hpix^[1];
          B2 := hpix^[0];

          if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then begin
            R := R1 + (R2 - R1) * 50 div (Percent + 50);
            G := G1 + (G2 - G1) * 50 div (Percent + 50);
            B := B1 + (B2 - B1) * 50 div (Percent + 50);
            hpix^[2] := R;
            hpix^[1] := G;
            hpix^[0] := B;
          end;
        end; 

        if p <> Rect.Right - 1 then begin 
          //Pixel rechts
          //Pixel right 
          hpix := pix; 
          inc(hpix); 
          R2 := hpix^[2]; 
          G2 := hpix^[1]; 
          B2 := hpix^[0]; 

          if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then begin
            R := R1 + (R2 - R1) * 50 div (Percent + 50);
            G := G1 + (G2 - G1) * 50 div (Percent + 50); 
            B := B1 + (B2 - B1) * 50 div (Percent + 50);
            hpix^[2] := R; 
            hpix^[1] := G; 
            hpix^[0] := B;
          end;
        end;

        if prevscan <> nil then begin
          //Pixel oben
          //Pixel up 
          R2 := prevscan^[2]; 
          G2 := prevscan^[1]; 
          B2 := prevscan^[0]; 

          if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then begin 
            R := R1 + (R2 - R1) * 50 div (Percent + 50); 
            G := G1 + (G2 - G1) * 50 div (Percent + 50); 
            B := B1 + (B2 - B1) * 50 div (Percent + 50); 
            prevscan^[2] := R; 
            prevscan^[1] := G;
            prevscan^[0] := B;
          end; 
          Inc(prevscan);
        end; 

        if nextscan <> nil then begin
          //Pixel unten 
          //Pixel down
          R2 := nextscan^[2]; 
          G2 := nextscan^[1];
          B2 := nextscan^[0]; 

          if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then begin 
            R := R1 + (R2 - R1) * 50 div (Percent + 50); 
            G := G1 + (G2 - G1) * 50 div (Percent + 50); 
            B := B1 + (B2 - B1) * 50 div (Percent + 50); 
            nextscan^[2] := R; 
            nextscan^[1] := G; 
            nextscan^[0] := B; 
          end; 
          Inc(nextscan); 
        end;
        Inc(pix);
      end;
    end;
  end;

  bitmap.SaveToFile(Nomearquivo);


end;


procedure TForm1.Button1Click(Sender: TObject);
VAR
  myrectdestino : TRect;
  Origem, destino : TJpegimage;
  qualidade : integer;
  Largura, altura : integer;
  suavizacao : integer;
  bmp : TBitmap;

  NomeArquivoOrigem, NomeArquivoDestino : String;

begin
   qualidade := 100; // 100%
   suavizacao := 10;
   largura := 800;
   altura := 600;
   NomeArquivoOrigem := 'c:\1.jpg';
   NomeArquivoDestino := 'c:\2.jpg';


   Origem := TJpegimage.Create;
   Origem.LoadFromFile(nomearquivoorigem);

   myrectdestino := rect(0,0,LARGURA,ALTURA);
   Bmp := TBitmap.Create;
   bmp.width := largura;
   bmp.height := altura;

   bmp.Canvas.StretchDraw(myrectdestino,origem);
   Antialiasing(bmp, myrectdestino,SUAVIZACAO,'c:\a.bmp');//vou salvar em bmp, 
pq o delphi tem algum problema para converter direto para jpg, e a imagem fica 
ruim....

   destino:= TJpegImage.Create;
   bmp.LoadFromFile('c:\a.bmp');

   destino.Assign(bmp);
   destino.SaveToFile(nomearquivodestino);
   destino.Free;
   deletefile('C:\A.BMP')
end;



end.



  ----- Original Message ----- 
  From: Hudson 
  To: delphi-br@yahoogrupos.com.br 
  Sent: Thursday, February 08, 2007 8:13 PM
  Subject: [delphi-br] Trabalhar com imagem no delphi


  Ola, 
  Mais uma duvida q não consegui tira-la na internet...

  gostaria de abrir a imagem usando o image1 com openimage e quando for salvar 
definir o tamanho da mesma....

  por exemplo:
  quando abrir o jpg com o tamanho 1600X1200
  salva-lo como jpg 600X400

  sera q isso teria geito?

  [As partes desta mensagem que não continham texto foram removidas]



   

  __________ Informação do NOD32 IMON 2046 (20070208) __________

  Esta mensagem foi verificada pelo NOD32 sistema antivírus
  http://www.eset.com.br


[As partes desta mensagem que não continham texto foram removidas]