delphi - trasformare immagine in vettoriale illustrator



Come posso creare una bitmap con uno sfondo chiaro su un modulo trasparente? (1)

Sto cercando di creare un modulo completamente trasparente in cima al quale disegno una bitmap con trasparenza alfa. Il problema è che non riesco a capire come impostare lo sfondo della bitmap su Alpha 0 (totalmente visibile).

Ecco come appare la forma ora (nota in alto a destra non trasparente).

Ecco come voglio che guardi (in alto a destra totalmente trasparente):

Ecco la mia fonte:

unit frmMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ActiveX,

  GDIPObj, GDIPAPI, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm7 = class(TForm)
    Panel1: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
  private
    function CreateTranparentForm: TForm;
  end;

var
  Form7: TForm7;

implementation

{$R *.dfm}

// Thanks to Anders Melander for the transparent form tutorial
// (http://melander.dk/articles/alphasplash2/2/)
function CreateAlphaBlendForm(AOwner: TComponent; Bitmap: TBitmap; Alpha: Byte): TForm;

  procedure PremultiplyBitmap(Bitmap: TBitmap);
  var
    Row, Col: integer;
    p: PRGBQuad;
    PreMult: array[byte, byte] of byte;
  begin
    // precalculate all possible values of a*b
    for Row := 0 to 255 do
      for Col := Row to 255 do
      begin
        PreMult[Row, Col] := Row*Col div 255;

        if (Row <> Col) then
          PreMult[Col, Row] := PreMult[Row, Col]; // a*b = b*a
      end;

    for Row := 0 to Bitmap.Height-1 do
    begin
      Col := Bitmap.Width;

      p := Bitmap.ScanLine[Row];

      while (Col > 0) do
      begin
        p.rgbBlue := PreMult[p.rgbReserved, p.rgbBlue];
        p.rgbGreen := PreMult[p.rgbReserved, p.rgbGreen];
        p.rgbRed := PreMult[p.rgbReserved, p.rgbRed];

        inc(p);
        dec(Col);
      end;
    end;
  end;

var
  BlendFunction: TBlendFunction;
  BitmapPos: TPoint;
  BitmapSize: TSize;
  exStyle: DWORD;
  PNGBitmap: TGPBitmap;
  BitmapHandle: HBITMAP;
  Stream: TMemoryStream;
  StreamAdapter: IStream;
begin
  Result := TForm.Create(AOwner);

  // Enable window layering
  exStyle := GetWindowLongA(Result.Handle, GWL_EXSTYLE);

  if (exStyle and WS_EX_LAYERED = 0) then
    SetWindowLong(Result.Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);

  // Load the PNG from a resource
  Stream := TMemoryStream.Create;
  try
    Bitmap.SaveToStream(Stream);

    // Wrap the VCL stream in a COM IStream
    StreamAdapter := TStreamAdapter.Create(Stream);
    try
      // Create and load a GDI+ bitmap from the stream
      PNGBitmap := TGPBitmap.Create(StreamAdapter);
      try
        // Convert the PNG to a 32 bit bitmap
        PNGBitmap.GetHBITMAP(MakeColor(0,0,0,0), BitmapHandle);

        // Wrap the bitmap in a VCL TBitmap
        Bitmap.Handle := BitmapHandle;
      finally
        FreeAndNil(PNGBitmap);
      end;
    finally
      StreamAdapter := nil;
    end;
  finally
    FreeAndNil(Stream);
  end;

  // Perform run-time premultiplication
  PremultiplyBitmap(Bitmap);

  // Resize form to fit bitmap
  Result.ClientWidth := Bitmap.Width;
  Result.ClientHeight := Bitmap.Height;

  // Position bitmap on form
  BitmapPos := Point(0, 0);
  BitmapSize.cx := Bitmap.Width;
  BitmapSize.cy := Bitmap.Height;

  // Setup alpha blending parameters
  BlendFunction.BlendOp := AC_SRC_OVER;
  BlendFunction.BlendFlags := 0;
  BlendFunction.SourceConstantAlpha := Alpha;
  BlendFunction.AlphaFormat := AC_SRC_ALPHA;

  UpdateLayeredWindow(Result.Handle, 0, nil, @BitmapSize, Bitmap.Canvas.Handle,
    @BitmapPos, 0, @BlendFunction, ULW_ALPHA);
end;

procedure CopyControlToBitmap(AWinControl: TWinControl; Bitmap: TBitmap; X, Y: Integer);
var
 SrcDC: HDC;
begin
  SrcDC := GetDC(AWinControl.Handle);
  try
    BitBlt(Bitmap.Canvas.Handle, X, Y, AWinControl.ClientWidth, AWinControl.ClientHeight, SrcDC, 0, 0, SRCCOPY);
  finally
     ReleaseDC(AWinControl.Handle, SrcDC);
  end;
end;

function MakeGDIPColor(C: TColor; Alpha: Byte): Cardinal;
var
  tmpRGB : TColorRef;
begin
  tmpRGB := ColorToRGB(C);

  result := ((DWORD(GetBValue(tmpRGB)) shl  BlueShift) or
             (DWORD(GetGValue(tmpRGB)) shl GreenShift) or
             (DWORD(GetRValue(tmpRGB)) shl   RedShift) or
             (DWORD(Alpha) shl AlphaShift));
end;

procedure TForm7.Button2Click(Sender: TObject);
begin
  CreateTranparentForm.Show;
end;

function TForm7.CreateTranparentForm: TForm;
const
  TabHeight = 50;
  TabWidth = 150;
var
  DragControl: TWinControl;
  DragCanvas: TGPGraphics;
  Bitmap: TBitmap;
  ControlTop: Integer;
  DragBrush: TGPSolidBrush;
begin
  DragControl := Panel1;

  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;

    Bitmap.Height := TabHeight + DragControl.Height;
    Bitmap.Width := DragControl.Width;
    ControlTop := TabHeight;

    // <<<< I need to clear the bitmap background here!!!

    CopyControlToBitmap(DragControl, Bitmap, 0, ControlTop);

    DragCanvas := TGPGraphics.Create(Bitmap.Canvas.Handle);
    DragBrush := TGPSolidBrush.Create(MakeGDIPColor(clBlue, 255));
    try
      // Do the painting...
      DragCanvas.FillRectangle(DragBrush, 0, 0, TabWidth, TabHeight);
    finally
      FreeAndNil(DragCanvas);
      FreeAndNil(DragBrush);
    end;

    Result := CreateAlphaBlendForm(Self, Bitmap, 210);
    Result.BorderStyle := bsNone;
  finally
    FreeAndNil(Bitmap);
  end;
end;

end.

... e il DFM:

object Form7: TForm7
  Left = 0
  Top = 0
  Caption = 'frmMain'
  ClientHeight = 300
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 256
    Top = 128
    Width = 321
    Height = 145
    Caption = 'Panel1'
    TabOrder = 0
    object Edit1: TEdit
      Left = 40
      Top = 24
      Width = 121
      Height = 21
      TabOrder = 0
      Text = 'Edit1'
    end
    object Button1: TButton
      Left = 40
      Top = 64
      Width = 75
      Height = 25
      Caption = 'Button1'
      TabOrder = 1
    end
  end
  object Button2: TButton
    Left = 16
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Go'
    TabOrder = 1
    OnClick = Button2Click
  end
end

Grazie.


Sembra che tu abbia BLENDFUNCTION sbagliata di come funziona UpdateLayeredWindow / BLENDFUNCTION . Con UpdateLayeredWindow , usi o meno pixel alfa o un tasto colorato. Lo chiamerai con ULW_ALPHA come 'dwFlags', il che significa che intendi usare alpha per pixel, e passi una bitmap completamente opaca alla tua routine di premoltiplicazione (tutti i pixel hanno un valore alfa di 255). La tua routine di premoltiplicazione non modifica il canale alfa, tutto quello che fa è calcolare i valori di verde e blu rossi in base al canale alfa della bitmap passata. Alla fine, quello che hai è un bitmap completamente opaco con correttamente calcolato r, g, b (anche non modificato, dal 255/255 = 1). Tutta la trasparenza che ottieni è dal '210' che assegni a SourceConstantAlpha di BlendFunction . Cosa offre UpdateLayeredWindow con una finestra semitrasparente, ogni pixel ha la stessa trasparenza.

Il riempimento di una regione della bitmap, menzionato nei commenti alla domanda, sembra funzionare perché la chiamata FillRect sovrascrive il canale alfa. I pixel che hanno un alfa di 255 ora hanno un alfa di 0. IMO, normalmente questo dovrebbe essere considerato come causa di comportamento indefinito a meno che non si comprenda pienamente come / perché funziona.

La domanda, nel suo stato attuale, richiede una risposta per l'utilizzo di un tasto di colore anziché dell'alfa per pixel o per il taglio di una regione del modulo ( SetWindowRgn ). Se deve essere utilizzato alfa pixel, dovrebbe essere applicato in modo diverso a parti della bitmap. Nei commenti alla domanda, si cita che la bitmap deve essere ridimensionata ad un certo punto. Devi anche essere sicuro che il codice di ridimensionamento preserva il canale alfa, se usato.





delphi-xe2