{----------------------------------------------------------------}
{ PNGFORM - Sub0 - Developpez.com - 10/06/06                     }
{----------------------------------------------------------------}
{$X+}
Unit Unit1;
Interface
Uses Windows, Messages, SysUtils, Classes, Graphics, Controls,
     Forms, Dialogs, ExtCtrls, StdCtrls, Math, PNGImage, HSLUtils;

Type
  TWMMoving=record
   Msg:Cardinal;
   fwSide:wParam;
   lprc:^TRect;
 end;

  Tpngform= class (tform)
  procedure NCHITTEST(var msg:tmessage);message WM_NCHITTEST;
  procedure wmmoving(var msg:TWMMoving);message wm_moving;
  procedure wmexitmove(var msg:tmessage);message WM_EXITSIZEMOVE;
  end;

  TForm1 = Class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    Procedure FormCreate(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure Button1Click(Sender: TObject);
  End;

Var
  Form1: TForm1;


{----------------------------------------------------------------}
{                                                                }
{                       }IMPLEMENTATION{                         }
{                                                                }
{----------------------------------------------------------------}
{$R *.DFM}

Var PNGForm: Tpngform;
    BmpForm: TBitmap;


{----------------------------------------------------------------}
{ Fusionne les controls et l'arrière-plan                        }
{----------------------------------------------------------------}
Procedure FusionForm(Var FusBitmap: TBitmap);
Var TmpBitmap: TBitmap;
    pd, pa: pByteArray;
    tcol: TRGB;
    i, j: Integer;
Begin
  TmpBitmap := TBitmap.Create;
  TmpBitmap.Width := Form1.Width;
  TmpBitmap.Height := Form1.Height;
  TmpBitmap.PixelFormat := pf24bit;
  TmpBitmap.Canvas.CopyRect(TmpBitmap.Canvas.ClipRect, Form1.Canvas, Form1.Canvas.ClipRect);
  FusBitmap := Nil;
  FusBitmap := TBitmap.Create;
  FusBitmap.Assign(BmpForm);
  FusBitmap.PixelFormat := pf32bit;
  tcol := GetRGB(Form1.TransparentColorValue);
  For j := 0 To BmpForm.Height - 1 Do Begin
    pd := FusBitmap.ScanLine[j];
    pa := TmpBitmap.ScanLine[j];
    For i := 0 To FusBitmap.Width - 1 Do Begin
      If (pa[i * 3 + 2] <> tcol.R) Or
         (pa[i * 3 + 1] <> tcol.G) Or
         (pa[i * 3 + 0] <> tcol.B) Then Begin
        pd[i * 4 + 0] := pa[i * 3 + 0];
        pd[i * 4 + 1] := pa[i * 3 + 1];
        pd[i * 4 + 2] := pa[i * 3 + 2];
        pd[i * 4 + 3] := $FF;
      End;
    End;
  End;
  TmpBitmap := Nil;
End;


{----------------------------------------------------------------}
{ Function pour obtenir l'image 32bits à la place d'une form     }
{----------------------------------------------------------------}
Function UpdateLayeredWindow(hwnd: HWND; hdcDst: HDC; pptDst: PPoint;
  psize: PSize; hdcSrc: HDC; pptSrc: PPoint; crKey: TColor;
  pblend: PBlendFunction; dwFlags: DWORD): BOOL; stdcall; external 'user32.dll';


{----------------------------------------------------------------}
{ Procédure appellant la fonction UpdateLayeredWindow            }
{----------------------------------------------------------------}
Procedure UpDateForm(Form: TForm; Bmp: TBitmap; Opacite: Byte = $FF);
Const WS_EX_LAYERED = $80000;
Var Size: PSIZE;
    TopLeft, BmpTopLeft: TPoint;
    Blend: TBlendFunction;
Begin
  With Form Do Begin
    SetWindowLong(Handle, GWL_EXSTYLE,
      GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
    New(Size);
    Size.cx := Width;
    Size.cy := Height;
    TopLeft := BoundsRect.TopLeft;
    BmpTopLeft := Point(0, 0);
    With Blend Do Begin
      BlendOp := 0;
      BlendFlags := 0;
      SourceConstantAlpha := Opacite;
      AlphaFormat := 1;
    End;
    Bmp.PixelFormat := pf32bit;
    UpdateLayeredWindow(Handle, GetDC(0), @TopLeft, Size,
      Bmp.Canvas.handle, @BmpTopLeft, 0, @Blend, 2);
  End;
End;


{----------------------------------------------------------------}
{ Fade Out du programme                                          }
{----------------------------------------------------------------}
Procedure FadeOutForm(Delay: Integer = 800);
Const Division = 40;
Var x: Integer;
    opacite: Byte;
    FusBitmap: TBitmap;
Begin
  Form1.BringToFront;
  FusionForm(FusBitmap);
  UpDateForm(PNGForm, Fusbitmap);
  Form1.Hide;
  For x := 1 To Division Do Begin
    opacite := Abs($FF - Round(Max(Min($FF / Division * x, $FF), 0)));
    UpDateForm(PNGForm, Fusbitmap, opacite);
    Sleep(Delay Div Division);
  End;
  UpDateForm(PNGForm, BmpForm, 0);
End;


{----------------------------------------------------------------}
{ Fade In du programme                                           }
{----------------------------------------------------------------}
Procedure FadeInForm(Delay: Integer = 800);
Const Division = 20;
Var x: Integer;
    opacite: Byte;
    FusBitmap: TBitmap;
Begin
  Form1.AlphaBlend := True;
  Form1.AlphaBlendValue := 0;
  PNGForm.Show;
  Form1.Show;
  Application.ProcessMessages;
  FusionForm(FusBitmap);
  UpDateForm(PNGForm, Fusbitmap, 0);
  Form1.Hide;
  Form1.AlphaBlend := False;
  Application.ProcessMessages;
  For x := 1 To Division Do Begin
    opacite := Round(Max(Min($FF / Division * x, $FF), 0));
    UpDateForm(PNGForm, Fusbitmap, opacite);
    Sleep(Delay Div Division);
  End;
  Form1.Show;
  UpDateForm(PNGForm, BmpForm);
End;


{----------------------------------------------------------------}
{ Chargement d'une image PNG dans un TBitmap 32bits              }
{----------------------------------------------------------------}
Function MyLoadPNG(fn: String; Var FinalBitmap: TBitmap): Boolean;
Var PNG: TPNGObject;
    AlphaBitmap: TBitmap;
    pd, pa: pByteArray;
    i, j, a: Integer;
Begin
  Result := False;
  FinalBitmap := Nil;
  FinalBitmap := TBitmap.Create;
  If (FileExists(fn) = False) Then Begin
    ShowMessage('Image ' + ExtractFilename(fn) + ' introuvable.');
    Exit;
  End;
  PNG := TPNGObject.Create;
  Try PNG.LoadFromFile(fn);
  Except
    ShowMessage('Erreur format PNG (' + ExtractFilename(fn) + ')');
    PNG := Nil;
    Exit;
  End;
  AlphaBitmap := TBitmap.Create;
  AlphaBitmap.Height := PNG.Height;
  AlphaBitmap.Width := PNG.Width;
  AlphaBitmap.PixelFormat := pf24bit;
  FinalBitmap.Assign(PNG);
  FinalBitmap.PixelFormat := pf32bit;
  If (Png.Transparent) Then Begin
    For i := 0 To PNG.Height - 1 Do
      For j := 0 To PNG.Width - 1 Do
        If (PNG.AlphaScanline[i][j] >= 240) Then
          AlphaBitmap.Canvas.Pixels[j, i] := $FFFFFF Else
          AlphaBitmap.Canvas.Pixels[j, i] := HSLRangeToRGB(0, 0, PNG.AlphaScanline[i][j]);
  End Else Begin
    AlphaBitmap.Canvas.Brush.Style := bsSolid;
    AlphaBitmap.Canvas.Brush.Color := $FFFFFF;
    AlphaBitmap.Canvas.FillRect(AlphaBitmap.Canvas.ClipRect);
  End;
  For j := 0 To PNG.Height - 1 Do Begin
    pd := FinalBitmap.ScanLine[j];
    pa := AlphaBitmap.ScanLine[j];
    For i := 0 To PNG.Width - 1 Do Begin
      a := pa[i * 3];
      If (a < 240) Then Begin
        pd[i * 4 + 0] := Round(Max(Min(pd[i * 4 + 0] * a / $FF, $FF), 0));
        pd[i * 4 + 1] := Round(Max(Min(pd[i * 4 + 1] * a / $FF, $FF), 0));
        pd[i * 4 + 2] := Round(Max(Min(pd[i * 4 + 2] * a / $FF, $FF), 0));
      End;
      pd[i * 4 + 3] := a;
    End;
  End;
  AlphaBitmap := Nil;
  PNG := Nil;
  Result := True;
End;


{----------------------------------------------------------------}
{ Dessin d'un TBitmap 32bits sur un autre (fusion)               }
{----------------------------------------------------------------}
Procedure MyDrawPNG(X, Y: Integer; AlphaBitmap, FinalBitmap: TBitmap);
Var pd, pa: pByteArray;
    i, ix, j, a, b, ad: Integer;
Begin
  If (Assigned(AlphaBitmap) = False) Then Exit;
  If (Assigned(FinalBitmap) = False) Then Exit;
  FinalBitmap.PixelFormat := pf32bit;
  For j := 0 To AlphaBitmap.Height - 1 Do
    If (j + Y <= FinalBitmap.Height - 1) And (j + Y >= 0) Then Begin
      pd := FinalBitmap.ScanLine[j + Y];
      pa := AlphaBitmap.ScanLine[j];
      For i := 0 To AlphaBitmap.Width - 1 Do Begin
        a := pa[i * 4 + 3];
        b := Abs($FF - a);
        ix := Max(Min(i + X, FinalBitmap.Width - 1), 0);
        ad := pd[ix * 4 + 3];
        If (a >= 240) Then Begin
          pd[ix * 4 + 0] := pa[i * 4 + 0];
          pd[ix * 4 + 1] := pa[i * 4 + 1];
          pd[ix * 4 + 2] := pa[i * 4 + 2];
          pd[ix * 4 + 3] := $FF;
        End Else If (a >= 0) Then Begin
          If (ad < 240) Then
            b := Round(Max(Min(a + (ad * b) / $FF, $FF), 0));;
          pd[ix * 4 + 0] := Round(Max(Min(
            pa[i * 4 + 0] + b * pd[ix * 4 + 0] / $FF, $FF), 0));
          pd[ix * 4 + 1] := Round(Max(Min(
            pa[i * 4 + 1] + b * pd[ix * 4 + 1] / $FF, $FF), 0));
          pd[ix * 4 + 2] := Round(Max(Min(
            pa[i * 4 + 2] + b * pd[ix * 4 + 2] / $FF, $FF), 0));
          If (ad < 240) Then pd[ix * 4 + 3] := b;
        End;
      End;
    End;
End;


{----------------------------------------------------------------}
{ Création & initialisation des forms                            }
{----------------------------------------------------------------}
Procedure TForm1.FormCreate(Sender: TObject);
Var bmp: TBitmap;
Begin
  DoubleBuffered := True;
  Color := clFuchsia;
  TransparentColorValue := Color;
  BorderStyle := bsNone;

  // Chargement de l'image PNG pour l'arrière-plan //
  If (MyLoadPNG('form.png', BmpForm)) Then Begin
    Width := BmpForm.Width;
    Height := BmpForm.Height;
  End;

  // Création de la form d'arrière-plan //
  PNGForm := tpngform.Createnew(self);
  With PNGForm Do Begin
    Parent := Form1.Parent;
    Name := 'PNGForm';
    Caption := Form1.Caption;
    FormStyle := Form1.FormStyle;
    BorderStyle := Form1.BorderStyle;
    BorderIcons := [];
    Position := Form1.Position;
    Left := Form1.Left;
    Top := Form1.Top;
    Width := Form1.Width;
    Height := Form1.Height;
    DoubleBuffered := True;
    Visible := False;
  End;

  // Exemple d'ajoût d'image PNG //
  MyLoadPNG('6c.png', bmp);
  MyDrawPNG(0, 28, bmp, BmpForm);
  //bmp := Nil;

  // Fusion de l'image finale sur la form & FadIn //
  UpDateForm(PNGForm, bmpform, 0);
    FadeInForm;
  FusionForm(bmp);
  UpDateForm(PNGForm, bmp);

End;

{----------------------------------------------------------------}
{ Finalisation du programme                                      }
{----------------------------------------------------------------}
Procedure TForm1.FormDestroy(Sender: TObject);
Begin
  BmpForm := Nil;
End;

{----------------------------------------------------------------}
{ Déplacement de la fenêtre (image et controls fusionnés)        }
{----------------------------------------------------------------}



{----------------------------------------------------------------}
{ Exemple d'objet actif -> Bouton EXIT                           }
{----------------------------------------------------------------}
Procedure TForm1.Button1Click(Sender: TObject);
begin
  FadeOutForm;
  Application.Terminate;
End;

procedure tpngform.NCHITTEST(var msg:tmessage);
begin
inherited;
msg.result:=htcaption;

end;

procedure tpngform.wmexitmove(var msg:tmessage);
begin
 inherited;
 form1.BringToFront;
end;



procedure tpngform.wmmoving(var msg:TWMMoving);
var FusBitmap:tbitmap;
x,y:integer;
begin
inherited;
 x:=msg.lprc.Left; y:=msg.lprc.Top;
 Form1.left:=x;form1.Top:=y;
 FusionForm(FusBitmap);
 UpDateForm(PNGForm, FusBitmap);



end;

{----------------------------------------------------------------}
End.