PNG Delphi Form, Button Probleme

[stOrM]

Jo könnte ich machen, der code exisitert hier aber bereits ist von Turbopascal...
Alles was er benutzt hat, benutze ich auch, mit dem kleinen Unterschied, das ich einen Grafikbutton auf der Form brauche...

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,


  PNGImage, GR32, GR32_PNG, PngExtraEx;


type
  TForm1 = class(TForm)
    Timer1: TTimer;
    PNGBtnEx1: TPNGBtnEx;
    PNGBtnEx2: TPNGBtnEx;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure PNGBtnEx1Click(Sender: TObject);
  private
    { Private declarations }
    ScrBmp32, PNGBmp32, tmpBmp32: TBitmap32;
    BlendF: TBlendFunction;
    P: TPoint;
    Size: TSize;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{$R ResMenu.RES}

var
  BlendValue : Byte = 240;

// Result is TRUE has Pngimage a Alphachannel.
function PNGToBitmap32(DstBitmap: TBitmap32; Png: TPngObject): Boolean;
var
  TransparentColor: TColor32;
  PixelPtr: PColor32;
  AlphaPtr: PByte;
  X, Y: Integer;
begin
  Result := False;

  DstBitmap.Assign(PNG);
  DstBitmap.ResetAlpha;

  case PNG.TransparencyMode of
    ptmPartial:
      begin
        if (PNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or
           (PNG.Header.ColorType = COLOR_RGBALPHA) then
        begin
          PixelPtr := PColor32(@DstBitmap.Bits[0]);
          for Y := 0 to DstBitmap.Height - 1 do
          begin
            AlphaPtr := PByte(PNG.AlphaScanline[Y]);
            for X := 0 to DstBitmap.Width - 1 do
            begin
              PixelPtr^ := (PixelPtr^ and $00FFFFFF) or (TColor32(AlphaPtr^) shl 24);
              Inc(PixelPtr);
              Inc(AlphaPtr);
            end;
          end;
        end;
        Result := True;
      end;
    ptmBit:
      begin
        TransparentColor := Color32(PNG.TransparentColor);
        PixelPtr := PColor32(@DstBitmap.Bits[0]);
        for X := 0 to (DstBitmap.Height - 1) * (DstBitmap.Width - 1) do
        begin
          if PixelPtr^ = TransparentColor then
            PixelPtr^ := PixelPtr^ and $00FFFFFF;
          Inc(PixelPtr);
        end;
        Result := True;
      end;
    ptmNone: Result := False;
  end;
end;

procedure ChangeCleartype(Canvas: TCanvas; ClearType: Boolean);
var
  lFnt: TLogFont;
  Fnt: TFont;
begin
  Fnt := TFont.Create;
  try
    Fnt.Assign(Canvas.Font);
    GetObject(Fnt.Handle, sizeof(lFnt), @lFnt);
    if ClearType
      then lFnt.lfQuality := DEFAULT_QUALITY
      else lFnt.lfQuality := NONANTIALIASED_QUALITY;
    Fnt.Handle := CreateFontIndirect(lFnt);
    Canvas.Font.Assign(Fnt);
  finally
    Fnt.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  PngImg : TPngObject;
begin
  BorderStyle := bsNone;

  ScrBmp32 := TBitmap32.Create;
  PNGBmp32 := TBitmap32.Create;
  tmpBmp32 := TBitmap32.Create;

  // Das PNG-Image aus der Resource holen und in ein TBitmap32
  // konvertieren.
  PngImg := TPngObject.Create;

  try
    PngImg.LoadFromResourceName(hInstance, 'SMENU');
    PNGToBitmap32(PNGBmp32, PngImg);
  finally
    PngImg.Free;
  end;

  // Das PNGBitmap32 dem Screen-Bitmap32 zuweisen
  ScrBmp32.Assign(PNGBmp32);

  // Fenstergrösse anpassen und Position setzen
  Width := ScrBmp32.Width;
  Height := ScrBmp32.Height;

  // Das Fenster mit neuen Parametern ausstatten um Transparenz zu ermöglichen

  SetWindowLong(Handle, GWL_EXSTYLE,
    GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED {or WS_EX_TRANSPARENT});

  // Fensterblendoptionen festlegen (für UpdateLayeredWindow)
  BlendF.BlendOp := AC_SRC_OVER;
  BlendF.BlendFlags := 0;
  BlendF.SourceConstantAlpha := BlendValue;
  BlendF.AlphaFormat := AC_SRC_ALPHA;

  P := Point(0, 0);
  Size.cx := ScrBmp32.Width;
  Size.cy := ScrBmp32.Height;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(PNGBmp32); // PNGBmp32.Free;
  FreeAndNil(tmpBmp32); // tmpBmp32.Free;
  FreeAndNil(ScrBmp32); // ScrBmp32.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  bmp : tBitmap;
begin
  try
  // Png Image auf Bitmap32 "Zeichnen"
   ScrBmp32.ResetAlpha;
   ScrBmp32.Assign(PNGBmp32);

  bmp := GetFormImage;
  try
    bmp.TransparentColor := clFuchsia;
    bmp.Transparent := TRUE;
    tmpBmp32.Assign(bmp);
  finally
    FreeAndNil(bmp); // bmp.Free;
  end;
  
  tmpBmp32.DrawMode := dmBlend;
  tmpBmp32.CombineMode := cmBlend;
  // Formbitmap auf ScreenBitmap zeichnen
  tmpBmp32.DrawTo(ScrBmp32, 0, 0);

  // aktualisieren des Fensters mit dem neuen Bitmap.
  BlendF.SourceConstantAlpha := BlendValue;  // Blendwert zwischen Desktop und Fenster (0..255)
  UpdateLayeredWindow(
    Handle, 0, nil, @Size, ScrBmp32.Handle, @P, 0, @BlendF, ULW_ALPHA);

  except
    on E: Exception do
      begin
        Timer1.Enabled := FALSE; // Timer aus bei Fehlern, sonst gibt es eine Messageflut...
        ShowMessage(E.Message);
        Close;
      end;
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift = [ssLeft] then  // Das verschieben der Form auf eine einfache Weise
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, $F012, 0);
  end;
end;


procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = vk_escape then
  close;
end;

end.

Wäre klasse, wenn Du das mal versuchen könntest, da Irgendwie einen Button draufzubekommen, wenn Du dafür eine Beispielgrafik inkl. Buttons brauchst, sag einfach bescheid, kann ich Dir schnell machen...

Viele Grüsse
Marc