whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

49 Visitors Online


 
...to fade in/out a TImage?
Autor: Jailbird
Homepage: http://jail.tip.nu
[ Print tip ]  

Tip Rating (15):  
     


// Speichert die Farbwerte / Stores the colors //
type
  
PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;

  /////////////////////////////////////////////////
  //                  Fade In                    //
  /////////////////////////////////////////////////


procedure FadeIn(ImageFileName: TFileName);
var
  
Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  
// Bitmaps vorbereiten / Preparing the Bitmap //
  
Bitmap := TBitmap.Create;
  try
    
Bitmap.PixelFormat := pf32bit;  // oder pf24bit / or pf24bit //
    
Bitmap.LoadFromFile(ImageFileName);
    BaseBitmap := TBitmap.Create;
    try
      
BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
      
for step := 0 to 32 do
      begin
        for 
y := 0 to (Bitmap.Height - 1) do
        begin
          
BaseRow := BaseBitmap.Scanline[y];
          // Farben vom Endbild holen / Getting colors from final image //
          
Row := Bitmap.Scanline[y];
          // Farben vom aktuellen Bild / Colors from the image as it is now //
          
for x := 0 to (Bitmap.Width - 1) do
          begin
            
Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
            
Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;
        Form1.Canvas.Draw(0, 0, Bitmap);   // neues Bild ausgeben / Output new image //
        
InvalidateRect(Form1.Handle, nil, False);
        // Fenster neu zeichnen / Redraw window //
        
RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      
BaseBitmap.Free;
    end;
  finally
    
Bitmap.Free;
  end;
end;

/////////////////////////////////////////////////
//                  Fade Out                   //
/////////////////////////////////////////////////


procedure FadeOut(ImageFileName: TFileName);
var
  
Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  
// Bitmaps vorbereiten / Preparing the Bitmap //
  
Bitmap := TBitmap.Create;
  try
    
Bitmap.PixelFormat := pf32bit;  // oder pf24bit / or pf24bit //
    
Bitmap.LoadFromFile(ImageFileName);
    BaseBitmap := TBitmap.Create;
    try
      
BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
     
for step := 32 downto do
      begin
        for 
y := 0 to (Bitmap.Height - 1) do
        begin
          
BaseRow := BaseBitmap.Scanline[y];
          // Farben vom Endbild holen / Getting colors from final image //
          
Row := Bitmap.Scanline[y];
          // Farben vom aktuellen Bild / Colors from the image as it is now //
          
for x := 0 to (Bitmap.Width - 1) do
          begin
            
Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
            
Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;
        Form1.Canvas.Draw(0, 0, Bitmap);   // neues Bild ausgeben / Output new image //
        
InvalidateRect(Form1.Handle, nil, False);
        // Fenster neu zeichnen / Redraw window //
        
RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      
BaseBitmap.Free;
    end;
  finally
    
Bitmap.Free;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  
FadeIn('C:\TestImage.bmp')
end;


{*****************************}
 {by Yucel Karapinar, ykarapinar@hotmail.com }

{ Only for 24 ve 32 bits bitmaps }

procedure FadeOut(const Bmp: TImage; Pause: Integer);
var
  
BytesPorScan, counter, w, h: Integer;
  p: pByteArray;
begin
  if not 
(Bmp.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
    raise 
Exception.Create('Error, bitmap format is not supporting.');
  try
    
BytesPorScan := Abs(Integer(Bmp.Picture.Bitmap.ScanLine[1]) -
      Integer(Bmp.Picture.Bitmap.ScanLine[0]));
  except
    raise 
Exception.Create('Error!!');
  end;

  for counter := 1 to 256 do
  begin
    for 
h := 0 to Bmp.Picture.Bitmap.Height - 1 do
    begin
      
P := Bmp.Picture.Bitmap.ScanLine[h];
      for w := 0 to BytesPorScan - 1 do
        if 
P^[w] > 0 then P^[w] := P^[w] - 1;
    end;
    Sleep(Pause);
    Bmp.Refresh;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  
FadeOut(Image1, 1);
end;


 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners