AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi TImage.Picture.Icon Verständisfrage
Thema durchsuchen
Ansicht
Themen-Optionen

TImage.Picture.Icon Verständisfrage

Ein Thema von Shark99 · begonnen am 28. Jan 2013 · letzter Beitrag vom 29. Jan 2013
Antwort Antwort
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#1

AW: TImage.Picture.Icon Verständisfrage

  Alt 28. Jan 2013, 23:03
versuchs mal damit ....

Delphi-Quellcode:

Procedure LoadPNGAsIcon(const fn: String; var ICO: TIcon);
var
  Header: PBitmapV5Header;
  hNewBitmap, hMonoBitmap: HBITMAP;
  Bits: Pointer;
  x, y: Integer;
  DC: HDC;
  IconInfo: _ICONINFO;
  Pixel: ^Integer;
  ScanLine: PRGBTriple;
  AlphaScanline: pByteArray;
  PNG: TPngObject;
begin

  PNG := TPngObject.Create;
  try
    PNG.LoadFromFile(fn);
    if not Assigned(ICO) then
      ICO := TIcon.Create;
    New(Header);
    FillMemory(Header, SizeOf(BitmapV5Header), 1);
    Header.bV5Size := SizeOf(BitmapV5Header);
    Header.bV5Width := PNG.Width;
    Header.bV5Height := -PNG.Height;
    Header.bV5Planes := 1;
    Header.bV5BitCount := 32;
    Header.bV5Compression := BI_BITFIELDS;
    Header.bV5RedMask := $00FF0000;
    Header.bV5GreenMask := $0000FF00;
    Header.bV5BlueMask := $000000FF;
    Header.bV5AlphaMask := $FF000000;
    DC := GetDC(0);
    hNewBitmap := CreateDIBSection(DC, PBitmapInfo(Header)^, DIB_RGB_COLORS,
      Bits, 0, 0);
    Dispose(Header);
    ReleaseDC(0, DC);
    hMonoBitmap := CreateBitmap(PNG.Width, PNG.Height, 1, 1, nil);
    Pixel := Bits;
    for y := 0 to PNG.Height - 1 do
    begin
      ScanLine := PNG.ScanLine[y];
      AlphaScanline := PNG.AlphaScanline[y];
      for x := 0 to PNG.Width - 1 do
      begin
        if Assigned(AlphaScanline) then
          Pixel^ := AlphaScanline[x]
        else
          Pixel^ := 255;
        Pixel^ := Pixel^ shl 8;
        Inc(Pixel^, ScanLine^.rgbtRed);
        Pixel^ := Pixel^ shl 8;
        Inc(Pixel^, ScanLine^.rgbtGreen);
        Pixel^ := Pixel^ shl 8;
        Inc(Pixel^, ScanLine^.rgbtBlue);
        Inc(Pixel);
        Inc(ScanLine);
      end;
    end;
    IconInfo.fIcon := true;
    IconInfo.hbmMask := hMonoBitmap;
    IconInfo.hbmColor := hNewBitmap;
    ICO.Handle := CreateIconIndirect(IconInfo);

    DeleteObject(hNewBitmap);
    DeleteObject(hMonoBitmap);
  finally
    PNG.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ICO:TIcon;
begin
  ICO := nil;
  LoadPNGAsIcon('C:\Bilder\about.png',ico);
  image1.Picture.Assign(ico);
  ico.Free;
end;
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)

Geändert von Bummi (28. Jan 2013 um 23:07 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 18:21 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz