{----------------------------------------------------------------}
{ PNGFORM - Sub0 - Developpez.com - 14/06/06                     }
{ Modifié par sfpx                                               }
{----------------------------------------------------------------}
Unit pngform;

Interface

Uses
  Windows, Forms, Messages, SysUtils, Classes, Math, Graphics, PNGImage, HSLUtils, dialogs;

Type
  TWMMoving = Record
    Msg: Cardinal;
    fwSide: wParam;
    lprc: ^TRect;
  End;
  Tpngfrm = 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;

  Tpngform = Class(TComponent)
  private
    FPNGPicture: tpicture;
    Procedure initialize(aowner: tcomponent);
    Procedure SetPNG(Value: TPicture);
    Function LoadPNG(Var FinalBitmap: TBitmap): Boolean;
  protected
  public
    TheForm: Tpngfrm;
    BmpForm: tbitmap;
    Procedure FusionForm(Var FusBitmap: TBitmap);
    Procedure FadeInForm(Delay: Integer = 800);
    Procedure show;
  published
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    Property PNGPicture: TPicture read FPNGPicture write SetPNG;
  End;

Procedure Register;

Implementation


{----------------------------------------------------------------}
Destructor tpngform.Destroy;
Begin
  FPNGPicture.Free;
  Inherited Destroy;
End;

{----------------------------------------------------------------}
Procedure tpngform.SetPNG(Value: TPicture);
Begin
  If Assigned(Value) Then
    FPNGPicture.Assign(Value)
  Else
    FPNGPicture.Graphic := Nil;
End;

{----------------------------------------------------------------}
Procedure tpngform.FusionForm(Var FusBitmap: TBitmap);
Var
  TmpBitmap: TBitmap;
  pd, pa: pByteArray;
  tcol: TRGB;
  i, j: Integer;
Begin

  TmpBitmap := TBitmap.Create;
  TmpBitmap.Width := tform(owner).Width;
  TmpBitmap.Height := tform(owner).Height;
  TmpBitmap.PixelFormat := pf24bit;
  TmpBitmap.Canvas.CopyRect(TmpBitmap.Canvas.ClipRect, tform(owner).Canvas, tform(owner).Canvas.ClipRect);
  FusBitmap := Nil;
  FusBitmap := TBitmap.Create;
  FusBitmap.Assign(BmpForm);
  FusBitmap.PixelFormat := pf32bit;
  tcol := GetRGB(tform(owner).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;


{----------------------------------------------------------------}
{ Chargement d'une image PNG dans un TBitmap 32bits              }
{----------------------------------------------------------------}
Function tpngform.LoadPNG(Var FinalBitmap: TBitmap): Boolean;
Var
  PNG: TPNGObject;
  AlphaBitmap: TBitmap;
  pd, pa: pByteArray;
  i, j, a: Integer;
Begin
  Result := False;
  PNG := TPNGObject.Create;
  If Fpngpicture.Graphic <> Nil Then png.Assign(Fpngpicture)
  Else Begin
    png.free;
    exit;
  End;
  FinalBitmap := Nil;
  FinalBitmap := TBitmap.Create;
  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;


{----------------------------------------------------------------}
Procedure tpngform.initialize(aowner: tcomponent);
Var
  bmp: TBitmap;
Begin

  With tform(aowner) Do
  Begin
    DoubleBuffered := True;
    Color := clFuchsia;
    TransparentColorValue := Color;
    BorderStyle := bsNone;
  End;
  If fpngpicture.graphic = Nil Then
    fpngpicture.Bitmap.Assign(tform(aowner).GetFormImage);

  If (LoadPNG(BmpForm)) Then Begin
    tform(aowner).Width := BmpForm.Width;
    tform(aowner).Height := BmpForm.Height;
  End;



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


  UpDateForm(Theform, bmpform, 0);
  FadeInForm;

End;

{----------------------------------------------------------------}
Procedure tpngform.show;
Begin
  initialize(owner);
End;

{----------------------------------------------------------------}
Constructor tpngform.Create(AOwner: TComponent);
Begin

  Inherited Create(AOwner);
  Fpngpicture := tpicture.Create;
  Fpngpicture.Graphic := Nil;

End;

{----------------------------------------------------------------}
Procedure tpngfrm.NCHITTEST(Var msg: tmessage);
Var
  FusBitmap: tbitmap;
Begin
  Inherited;
  msg.result := htcaption;
  tpngform(owner).FusionForm(FusBitmap);
  UpDateForm(tform(self), FusBitmap);

End;

{----------------------------------------------------------------}
Procedure tpngfrm.wmexitmove(Var msg: tmessage);
Begin
  Inherited;
  tform(tpngform(owner).Owner).BringToFront;
End;


{----------------------------------------------------------------}
Procedure tpngfrm.wmmoving(Var msg: TWMMoving);
Var
  FusBitmap: tbitmap;
  x, y: integer;
Begin
  Inherited;
  x := msg.lprc.Left; y := msg.lprc.Top;
  tform(tpngform(owner).Owner).left := x;
  tform(tpngform(owner).Owner).Top := y;
  tpngform(owner).FusionForm(FusBitmap);
  UpDateForm(tform(self), FusBitmap);
End;


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

{----------------------------------------------------------------}
Procedure Register;
Begin
  RegisterComponents('Samples', [Tpngform]);
End;

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