View Issue Details

IDProjectCategoryView StatusLast Update
0015832LazarusLCLpublic2011-12-01 11:23
ReporterRamin JafariAssigned ToFelipe Monteiro de Carvalho 
PrioritynormalSeveritycrashReproducibilityalways
Status closedResolutionfixed 
Product Version0.9.28.3 (SVN)Product Build 
Target VersionFixed in Version0.9.29 (SVN) 
Summary0015832: Memory Leak for Alphablend in "StretchMaskBlt" (lclintfh.inc) Only in Arm-WinCE
DescriptionMemory Leak when draw an alpha-blend image (PNG) in WinCE using StretchMaskBlt.
i think it is in CreatePremultipliedBitmap or GetBitmapBytes in StretchMaskBlt.
i tested it with lazarus 0.9.29.xxxx + fpc 2.3.1 and 2.4.1, with Windows mobile 6.1 and 6.5 on my Samsung Omnia. Please HELP ...
TagsNo tags attached.
Fixed in Revision24093
LazTarget-
WidgetsetWinCE
Attached Files
  • TWinCEWidgetSet-StretchMaskBlt.patch (7,815 bytes)
    Index: interfaces/wince/wincewinapi.inc
    ===================================================================
    --- interfaces/wince/wincewinapi.inc	(revision 24068)
    +++ interfaces/wince/wincewinapi.inc	(working copy)
    @@ -3020,6 +3020,7 @@
       rectangle.  Sizing is done according to the stretching mode currently set in
       the destination device context.
      ------------------------------------------------------------------------------}
    +(*
     function TWinCEWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
       function CreatePremultipliedBitmap(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP): HBITMAP;
       var
    @@ -3180,7 +3181,194 @@
     
       Result := true;
     end;
    +*)
    +function TWinCEWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
     
    +function CreatePremultipliedBitmap(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP; out AAlphaBmp: HBITMAP): Boolean;
    +var
    +  _I : Integer;
    +  Data : Pointer = nil;
    +  DestData : Pointer = nil;
    +  Pixel : PRGBAQuad;
    +  ByteCount: PtrUInt;
    +  Info: record
    +    Header: Windows.TBitmapInfoHeader;
    +    Colors: array[0..3] of Cardinal; // reserve extra color for colormasks
    +  end;
    +  HasAlpha0, HasAlphaN, HasAlpha255: Boolean;
    +
    +begin
    +  Result := False;
    +  // process only requested rectangle
    +  if not GetBitmapBytes(ABitmap, Rect(XSrc, YSrc, XSrc+SrcWidth, YSrc+SrcHeight), rileDWordBoundary, Data, ByteCount) then Exit;
    +
    +  HasAlpha0 := False;
    +  HasAlphaN := False;
    +  HasAlpha255 := False;
    +  Pixel := Data;
    +  For _I := 1 To ByteCount shr 2 Do
    +  begin
    +    //Pixel^.Alpha := (Pixel^.Alpha * Alpha) div 255;
    +    If Pixel^.Alpha = 255 Then
    +      HasAlpha255 := True
    +    else
    +      If Pixel^.Alpha = 0 Then
    +      begin
    +        ZeroMemory(Pixel, SizeOf(TRGBAQuad));
    +        HasAlpha0 := True;
    +      end
    +      else
    +      begin
    +        Pixel^.Red   := (Pixel^.Red   * Pixel^.Alpha) div 255;
    +        Pixel^.Green := (Pixel^.Green * Pixel^.Alpha) div 255;
    +        Pixel^.Blue  := (Pixel^.Blue  * Pixel^.Alpha) div 255;
    +        HasAlphaN := True;
    +      end;
    +    //
    +    Inc(Pixel);
    +  end;
    +
    +  // only create bitmap when not opaque or not fully transparent
    +  // (all zero alpha is unlikly for alpha bitmap, so it is probably a bitmap without alpha channel)
    +  Result := HasAlphaN or (HasAlpha0 and HasAlpha255);
    +  if Result then
    +  begin
    +    ZeroMemory(@Info.Header, SizeOf(Info.Header));
    +    Info.Header.biSize := SizeOf(Info.Header);
    +    Info.Header.biWidth := SrcWidth;
    +    Info.Header.biHeight := -SrcHeight;
    +    Info.Header.biPlanes := 1;
    +    Info.Header.biBitCount := 32;
    +    Info.Header.biSizeImage := (SrcWidth * SrcHeight) shl 2;
    +    Info.Header.biCompression := BI_BITFIELDS; // CE only supports bitfields
    +    Info.Colors[0] := $FF0000; {le-red}
    +    Info.Colors[1] := $00FF00; {le-green}
    +    Info.Colors[2] := $0000FF; {le-blue}
    +    AAlphaBmp := Windows.CreateDIBSection({SrcDC}0, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS, DestData, 0, 0);
    +    Result := (AAlphaBmp <> 0) and (Data <> nil) and (DestData <> nil);
    +    if Result Then MoveMemory(DestData, Data, ByteCount);
    +  end;
    +
    +  if Data <> nil Then FreeMem(Data, ByteCount);
    +end;
    +
    +var
    +  MaskDC, CopyDC, AlphaDC: HDC;
    +  MaskObj, CopyObj, AlphaObj : HGDIOBJ;
    +  PrevTextColor, PrevBkColor : COLORREF;
    +  WinBmp: Windows.TBitmap;
    +  Bmp, CopyBmp, AlphaBmp : HBITMAP;
    +  HasAlpha: Boolean;
    +  Blend: TBlendFunction;
    +
    +begin
    +  Result := False;
    +  //if Alpha = 0 then Exit;
    +  // check if the Src has an alpha channel
    +  Bmp := Windows.GetCurrentObject(SrcDC, OBJ_BITMAP);
    +  // get info
    +  HasAlpha := (Windows.GetObject(Bmp, SizeOf(WinBmp), @WinBmp) <> 0)
    +          and (WinBmp.bmBitsPixel = 32)
    +          and CreatePremultipliedBitmap(WinBmp, Bmp, AlphaBmp);
    +
    +  if HasAlpha then
    +  begin
    +    // premultiply pixels
    +    AlphaDC := Windows.CreateCompatibleDC(SrcDC);
    +    AlphaObj := Windows.SelectObject(AlphaDC, AlphaBmp);
    +
    +    // init blendfunction
    +    Blend.BlendOp := AC_SRC_OVER;
    +    Blend.BlendFlags := 0;
    +    Blend.SourceConstantAlpha := 255;
    +    Blend.AlphaFormat := AC_SRC_ALPHA;
    +  end;
    +
    +  {$IfNDef WinCE}
    +  Windows.SetStretchBltMode(DestDC, STRETCH_HALFTONE);
    +  {$EndIf}
    +  Windows.SetBrushOrgEx(DestDC, 0, 0, nil);
    +  if Mask = 0 then
    +  begin
    +    if HasAlpha then
    +    begin
    +      Result := WinCEExtra.AlphaBlend(DestDC, X, Y, Width, Height, AlphaDC, 0, 0, SrcWidth, SrcHeight, Blend);
    +    end
    +    else
    +    begin
    +      if (Width = SrcWidth) and (Height = SrcHeight) then
    +        Result := Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SRCCOPY)
    +      else
    +        Result := Windows.StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCCOPY);
    +    end;
    +  end
    +  else
    +  begin
    +    MaskDC := Windows.CreateCompatibleDC(DestDC);
    +    MaskObj := Windows.SelectObject(MaskDC, Mask);
    +
    +    PrevTextColor := Windows.SetTextColor(DestDC, $00000000);
    +    PrevBkColor := Windows.SetBkColor(DestDC, $00FFFFFF);
    +
    +    if HasAlpha then
    +    begin
    +      // create copy of masked destination
    +      CopyDC := Windows.CreateCompatibleDC(DestDC);
    +      CopyBmp := Windows.CreateCompatibleBitmap(DestDC, Width, Height);
    +      CopyObj := Windows.SelectObject(CopyDC, CopyBmp);
    +      Windows.BitBlt(CopyDC, 0, 0, Width, Height, DestDC, X, Y, SRCCOPY);
    +      // wipe non masked area -> white
    +      Windows.SetTextColor(CopyDC, $00FFFFFF);
    +      Windows.SetBkColor(CopyDC, $00000000);
    +      if (Width = SrcWidth) and (Height = SrcHeight)
    +      then Windows.BitBlt(CopyDC, 0, 0, Width, Height, MaskDC, XSrc, YSrc, SRCPAINT)
    +      else Windows.StretchBlt(CopyDC, 0, 0, Width, Height, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCPAINT);
    +
    +      // copy source
    +      WinCEExtra.AlphaBlend(DestDC, X, Y, Width, Height, AlphaDC, 0, 0, SrcWidth, SrcHeight, Blend);
    +      // wipe masked area -> white
    +      if (Width = SrcWidth) and (Height = SrcHeight)
    +      then Windows.BitBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SRCPAINT)
    +      else Windows.StretchBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCPAINT);
    +
    +      // paint copied destination
    +      Windows.BitBlt(DestDC, X, Y, Width, Height, CopyDC, 0, 0, SRCAND);
    +
    +      // Restore stuff
    +      Windows.SelectObject(CopyDC, CopyObj);
    +      Windows.DeleteObject(CopyBmp);
    +      Windows.DeleteDC(CopyDC);
    +    end
    +    else
    +    begin
    +      if (Width = SrcWidth) and (Height = SrcHeight) then
    +      begin
    +        Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SRCINVERT);
    +        Windows.BitBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SRCAND);
    +        Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SRCINVERT);
    +      end
    +      else
    +      begin
    +        Windows.StretchBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SrcWidth, SrcHeight, SRCINVERT);
    +        Windows.StretchBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCAND);
    +        Windows.StretchBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SrcWidth, SrcHeight, SRCINVERT);
    +      end;
    +    end;
    +    Windows.SetTextColor(DestDC, PrevTextColor);
    +    Windows.SetBkColor(DestDC, PrevBkColor);
    +    Windows.SelectObject(MaskDC, MaskObj);
    +    Windows.DeleteDC(MaskDC);
    +  end;
    +
    +  if HasAlpha then
    +  begin
    +    Windows.SelectObject(AlphaDC, AlphaObj);
    +    Windows.DeleteObject(AlphaBmp);
    +    Windows.DeleteDC(AlphaDC);
    +  end;
    +
    +  Result := true;
    +end;
     {------------------------------------------------------------------------------
       Method:  TextOut
       Params: DC    - handle of device context
    

Relationships

has duplicate 0015811 closedVincent Snijders Memory Leak for Alphablend in "StretchMaskBlt (lclintfh.inc) 
related to 0015877 closedFelipe Monteiro de Carvalho Access Vilation on Canvas.Draw WinCE 

Activities

Ramin Jafari

2010-03-01 15:04

reporter   ~0034879

i found it!
in StretchMaskBlt > CreatePremultipliedBitmap must freemem(srcdata) from begin (keep it first and freemem at end)

Ramin Jafari

2010-03-01 15:07

reporter   ~0034880

function CreatePremultipliedBitmap(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP): HBITMAP;
  var
    _I : Integer; _Alpha : Byte;
    SrcData: Pointer = nil;
    SrcPixel: PRGBAQuad{ absolute SrcData};
    DstPixel: PRGBAQuad{ absolute DstData};
    ByteCount: PtrUInt;
    Info: record
      Header: Windows.TBitmapInfoHeader;
      Colors: array[0..3] of Cardinal; // reserve extra color for colormasks
    end;

  begin
    Result := 0;
    if not GetBitmapBytes(ABitmap, Rect(XSrc, YSrc, SrcWidth, SrcHeight), rileDWordBoundary, SrcPixel, ByteCount) then Exit;
    Try
      FillChar(Info.Header, SizeOf(Info.Header), 0);
      Info.Header.biSize := SizeOf(Info.Header);
      Info.Header.biWidth := SrcWidth;
      Info.Header.biHeight := -SrcHeight;
      Info.Header.biPlanes := 1;
      Info.Header.biBitCount := 32;
      Info.Header.biSizeImage := (SrcWidth * SrcHeight) shl 2;
      // CE only supports bitfields
      Info.Header.biCompression := BI_BITFIELDS;
      Info.Colors[0] := $FF0000; {le-red}
      Info.Colors[1] := $00FF00; {le-green}
      Info.Colors[2] := $0000FF; {le-blue}

      Result := Windows.CreateDIBSection(SrcDC, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS, DstPixel{DstData}, 0, 0);

      SrcData := SrcPixel; // Save Start Of Memory for Free at End of proc

      if (Result = 0) or (DstPixel = nil) then Exit;

      ByteCount := ByteCount shr 2;
      For _I := 1 To ByteCount Do
      begin
        DstPixel^.Alpha := (SrcPixel^.Alpha * Alpha) div 255;
        DstPixel^.Red := (SrcPixel^.Red * DstPixel^.Alpha) div 255;
        DstPixel^.Green := (SrcPixel^.Green * DstPixel^.Alpha) div 255;
        DstPixel^.Blue := (SrcPixel^.Blue * DstPixel^.Alpha) div 255;
        Inc(SrcPixel);
        Inc(DstPixel);
      end;
    finally
      If SrcData <> nil Then Freemem(SrcData, Info.Header.biSizeImage);
    end;
  end;

Ramin Jafari

2010-03-01 15:08

reporter   ~0034881

also i add Alpha in parameters

Andrzej Kałuża

2010-03-02 09:04

reporter   ~0034895

Thanks, it's solve my issue 0015877

Felipe Monteiro de Carvalho

2010-03-09 13:40

developer   ~0035082

But what are your changes exactly? Could you provide a patch? Here is how to create one: http://wiki.lazarus.freepascal.org/Creating_A_Patch

thanks,

Ramin Jafari

2010-03-09 18:25

reporter   ~0035089

Last edited: 2010-03-09 18:53

as soon as, but this is finally (for both Win32 and WinCE)
- faster (for Partial works with PNG)
- "alpha" parameter (only for PNG)
- no bug

Uses
  lclType, lclintf, GraphType,
  {$IfDef WinCE}
  WinCEProc, WinCEExtra;
  {$Else}
  Win32Proc, Win32Extra;
  {$EndIf}

function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
                        SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
                        Mask: HBITMAP; XMask, YMask: Integer; Alpha : Byte = 255): Boolean;

function CreatePremultipliedBitmap(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP; out AAlphaBmp: HBITMAP): Boolean;
var
  _I : Integer;
  Data : Pointer = nil;
  DestData : Pointer = nil;
  Pixel : PRGBAQuad;
  ByteCount: PtrUInt;
  Info: record
    Header: Windows.TBitmapInfoHeader;
    Colors: array[0..3] of Cardinal; // reserve extra color for colormasks
  end;
  HasAlpha0, HasAlphaN, HasAlpha255: Boolean;

begin
  Result := False;
  // process only requested rectangle
  {$IfDef WinCE}
  if not GetBitmapBytes(ABitmap, Rect(XSrc, YSrc, XSrc+SrcWidth, YSrc+SrcHeight), rileDWordBoundary, Data, ByteCount) then Exit;
  {$Else}
  if not GetBitmapBytes(AWinBmp, ABitmap, Rect(XSrc, YSrc, XSrc+SrcWidth, YSrc+SrcHeight), rileDWordBoundary, riloTopToBottom, Data, ByteCount) then Exit;
  {$EndIf}

  HasAlpha0 := False;
  HasAlphaN := False;
  HasAlpha255 := False;
  Pixel := Data;
  For _I := 1 To ByteCount shr 2 Do
  begin
    Pixel^.Alpha := (Pixel^.Alpha * Alpha) div 255;
    If Pixel^.Alpha = 255 Then
      HasAlpha255 := True
    else
      If Pixel^.Alpha = 0 Then
      begin
        ZeroMemory(Pixel, SizeOf(TRGBAQuad));
        HasAlpha0 := True;
      end
      else
      begin
        Pixel^.Red := (Pixel^.Red * Pixel^.Alpha) div 255;
        Pixel^.Green := (Pixel^.Green * Pixel^.Alpha) div 255;
        Pixel^.Blue := (Pixel^.Blue * Pixel^.Alpha) div 255;
        HasAlphaN := True;
      end;
    //
    Inc(Pixel);
  end;

  // only create bitmap when not opaque or not fully transparent
  // (all zero alpha is unlikly for alpha bitmap, so it is probably a bitmap without alpha channel)
  Result := HasAlphaN or (HasAlpha0 and HasAlpha255);
  if Result then
  begin
    ZeroMemory(@Info.Header, SizeOf(Info.Header));
    Info.Header.biSize := SizeOf(Info.Header);
    Info.Header.biWidth := SrcWidth;
    Info.Header.biHeight := -SrcHeight;
    Info.Header.biPlanes := 1;
    Info.Header.biBitCount := 32;
    Info.Header.biSizeImage := (SrcWidth * SrcHeight) shl 2;
    {$IfDef WinCE}
    Info.Header.biCompression := BI_BITFIELDS; // CE only supports bitfields
    Info.Colors[0] := $FF0000; {le-red}
    Info.Colors[1] := $00FF00; {le-green}
    Info.Colors[2] := $0000FF; {le-blue}
    {$Else}
    Info.Header.biCompression := BI_RGB;
    {$EndIf}
    AAlphaBmp := Windows.CreateDIBSection({SrcDC}0, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS, DestData, 0, 0);
    Result := (AAlphaBmp <> 0) and (Data <> nil) and (DestData <> nil);
    if Result Then MoveMemory(DestData, Data, ByteCount);
  end;

  if Data <> nil Then FreeMem(Data, ByteCount);
end;

var
  MaskDC, CopyDC, AlphaDC: HDC;
  MaskObj, CopyObj, AlphaObj : HGDIOBJ;
  PrevTextColor, PrevBkColor : COLORREF;
  WinBmp: Windows.TBitmap;
  Bmp, CopyBmp, AlphaBmp : HBITMAP;
  HasAlpha: Boolean;
  Blend: TBlendFunction;

begin
  // check if the Src has an alpha channel
  Bmp := Windows.GetCurrentObject(SrcDC, OBJ_BITMAP);
  // get info
  HasAlpha := (Windows.GetObject(Bmp, SizeOf(WinBmp), @WinBmp) <> 0)
          and (WinBmp.bmBitsPixel = 32)
          and CreatePremultipliedBitmap(WinBmp, Bmp, AlphaBmp);

  if HasAlpha then
  begin
    // premultiply pixels
    AlphaDC := Windows.CreateCompatibleDC(SrcDC);
    AlphaObj := Windows.SelectObject(AlphaDC, AlphaBmp);

    // init blendfunction
    Blend.BlendOp := AC_SRC_OVER;
    Blend.BlendFlags := 0;
    Blend.SourceConstantAlpha := 255;
    Blend.AlphaFormat := AC_SRC_ALPHA;
  end;

  {$IfNDef WinCE}
  Windows.SetStretchBltMode(DestDC, STRETCH_HALFTONE);
  {$EndIf}
  Windows.SetBrushOrgEx(DestDC, 0, 0, nil);
  if Mask = 0 then
  begin
    if HasAlpha then
    begin
      {$IfDef WinCE}
      Result := WinCEExtra.AlphaBlend(DestDC, X, Y, Width, Height, AlphaDC, 0, 0, SrcWidth, SrcHeight, Blend);
      {$Else}
      Result := Win32Extra.AlphaBlend(DestDC, X, Y, Width, Height, AlphaDC, 0, 0, SrcWidth, SrcHeight, Blend);
      {$EndIf}
    end
    else
    begin
      if (Width = SrcWidth) and (Height = SrcHeight) then
        Result := Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SRCCOPY)
      else
        Result := Windows.StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCCOPY);
    end;
  end
  else
  begin
    MaskDC := Windows.CreateCompatibleDC(DestDC);
    MaskObj := Windows.SelectObject(MaskDC, Mask);

    PrevTextColor := Windows.SetTextColor(DestDC, $00000000);
    PrevBkColor := Windows.SetBkColor(DestDC, $00FFFFFF);

    if HasAlpha then
    begin
      // create copy of masked destination
      CopyDC := Windows.CreateCompatibleDC(DestDC);
      CopyBmp := Windows.CreateCompatibleBitmap(DestDC, Width, Height);
      CopyObj := Windows.SelectObject(CopyDC, CopyBmp);
      Windows.BitBlt(CopyDC, 0, 0, Width, Height, DestDC, X, Y, SRCCOPY);
      // wipe non masked area -> white
      Windows.SetTextColor(CopyDC, $00FFFFFF);
      Windows.SetBkColor(CopyDC, $00000000);
      if (Width = SrcWidth) and (Height = SrcHeight)
      then Windows.BitBlt(CopyDC, 0, 0, Width, Height, MaskDC, XSrc, YSrc, SRCPAINT)
      else Windows.StretchBlt(CopyDC, 0, 0, Width, Height, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCPAINT);

      // copy source
      {$IfDef WinCE}
      WinCEExtra.AlphaBlend(DestDC, X, Y, Width, Height, AlphaDC, 0, 0, SrcWidth, SrcHeight, Blend);
      {$Else}
      Win32Extra.AlphaBlend(DestDC, X, Y, Width, Height, AlphaDC, 0, 0, SrcWidth, SrcHeight, Blend);
      {$EndIf}
      // wipe masked area -> white
      if (Width = SrcWidth) and (Height = SrcHeight)
      then Windows.BitBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SRCPAINT)
      else Windows.StretchBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCPAINT);

      // paint copied destination
      Windows.BitBlt(DestDC, X, Y, Width, Height, CopyDC, 0, 0, SRCAND);

      // Restore stuff
      Windows.SelectObject(CopyDC, CopyObj);
      Windows.DeleteObject(CopyBmp);
      Windows.DeleteDC(CopyDC);
    end
    else
    begin
      if (Width = SrcWidth) and (Height = SrcHeight) then
      begin
        Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SRCINVERT);
        Windows.BitBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SRCAND);
        Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SRCINVERT);
      end
      else
      begin
        Windows.StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCINVERT);
        Windows.StretchBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCAND);
        Windows.StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCINVERT);
      end;
    end;
    Windows.SetTextColor(DestDC, PrevTextColor);
    Windows.SetBkColor(DestDC, PrevBkColor);
    Windows.SelectObject(MaskDC, MaskObj);
    Windows.DeleteDC(MaskDC);
  end;

  if HasAlpha then
  begin
    Windows.SelectObject(AlphaDC, AlphaObj);
    Windows.DeleteObject(AlphaBmp);
    Windows.DeleteDC(AlphaDC);
  end;

  Result := true;
end;

Felipe Monteiro de Carvalho

2010-03-09 21:19

developer   ~0035106

Sorry, but they have to be kept separate. Having the same code for similar interfaces was tryed with gtk1/gtk2 and was a disaster, so now we keep win32/wince strictly separated. Could you separate them into the original places and create a patch? thanks,

Felipe Monteiro de Carvalho

2010-03-09 21:58

developer   ~0035109

Ah, and please post the win32 change as a separate patch in a separate bug report ... I'm only the maintainer of WinCE, this will organize things better.

thanks,

Ramin Jafari

2010-03-16 21:00

reporter   ~0035664

i think resolved:
http://bugs.freepascal.org/view.php?id=15811

Vincent Snijders

2010-03-16 21:06

manager   ~0035665

15811 was resolved, because it was an exact duplicate of this issue, but no fix was applied.

Ramin Jafari

2010-03-17 08:38

reporter   ~0035688

oh yes, you are right, but how can i Create a Patch?
http://wiki.lazarus.freepascal.org/Creating_A_Patch
this url could not help me!
where can i see a Complete Instructions to create a patch?
thanks

Vincent Snijders

2010-03-17 09:40

manager   ~0035691

Those are the most complete instructions we have.
Where are the instructions unclear?

Of course you may search the web to find other instructions how to create a patch for a project that use SVN as source control system.

2010-03-17 17:25

 

TWinCEWidgetSet-StretchMaskBlt.patch (7,815 bytes)
Index: interfaces/wince/wincewinapi.inc
===================================================================
--- interfaces/wince/wincewinapi.inc	(revision 24068)
+++ interfaces/wince/wincewinapi.inc	(working copy)
@@ -3020,6 +3020,7 @@
   rectangle.  Sizing is done according to the stretching mode currently set in
   the destination device context.
  ------------------------------------------------------------------------------}
+(*
 function TWinCEWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
   function CreatePremultipliedBitmap(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP): HBITMAP;
   var
@@ -3180,7 +3181,194 @@
 
   Result := true;
 end;
+*)
+function TWinCEWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
 
+function CreatePremultipliedBitmap(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP; out AAlphaBmp: HBITMAP): Boolean;
+var
+  _I : Integer;
+  Data : Pointer = nil;
+  DestData : Pointer = nil;
+  Pixel : PRGBAQuad;
+  ByteCount: PtrUInt;
+  Info: record
+    Header: Windows.TBitmapInfoHeader;
+    Colors: array[0..3] of Cardinal; // reserve extra color for colormasks
+  end;
+  HasAlpha0, HasAlphaN, HasAlpha255: Boolean;
+
+begin
+  Result := False;
+  // process only requested rectangle
+  if not GetBitmapBytes(ABitmap, Rect(XSrc, YSrc, XSrc+SrcWidth, YSrc+SrcHeight), rileDWordBoundary, Data, ByteCount) then Exit;
+
+  HasAlpha0 := False;
+  HasAlphaN := False;
+  HasAlpha255 := False;
+  Pixel := Data;
+  For _I := 1 To ByteCount shr 2 Do
+  begin
+    //Pixel^.Alpha := (Pixel^.Alpha * Alpha) div 255;
+    If Pixel^.Alpha = 255 Then
+      HasAlpha255 := True
+    else
+      If Pixel^.Alpha = 0 Then
+      begin
+        ZeroMemory(Pixel, SizeOf(TRGBAQuad));
+        HasAlpha0 := True;
+      end
+      else
+      begin
+        Pixel^.Red   := (Pixel^.Red   * Pixel^.Alpha) div 255;
+        Pixel^.Green := (Pixel^.Green * Pixel^.Alpha) div 255;
+        Pixel^.Blue  := (Pixel^.Blue  * Pixel^.Alpha) div 255;
+        HasAlphaN := True;
+      end;
+    //
+    Inc(Pixel);
+  end;
+
+  // only create bitmap when not opaque or not fully transparent
+  // (all zero alpha is unlikly for alpha bitmap, so it is probably a bitmap without alpha channel)
+  Result := HasAlphaN or (HasAlpha0 and HasAlpha255);
+  if Result then
+  begin
+    ZeroMemory(@Info.Header, SizeOf(Info.Header));
+    Info.Header.biSize := SizeOf(Info.Header);
+    Info.Header.biWidth := SrcWidth;
+    Info.Header.biHeight := -SrcHeight;
+    Info.Header.biPlanes := 1;
+    Info.Header.biBitCount := 32;
+    Info.Header.biSizeImage := (SrcWidth * SrcHeight) shl 2;
+    Info.Header.biCompression := BI_BITFIELDS; // CE only supports bitfields
+    Info.Colors[0] := $FF0000; {le-red}
+    Info.Colors[1] := $00FF00; {le-green}
+    Info.Colors[2] := $0000FF; {le-blue}
+    AAlphaBmp := Windows.CreateDIBSection({SrcDC}0, Windows.PBitmapInfo(@Info)^, DIB_RGB_COLORS, DestData, 0, 0);
+    Result := (AAlphaBmp <> 0) and (Data <> nil) and (DestData <> nil);
+    if Result Then MoveMemory(DestData, Data, ByteCount);
+  end;
+
+  if Data <> nil Then FreeMem(Data, ByteCount);
+end;
+
+var
+  MaskDC, CopyDC, AlphaDC: HDC;
+  MaskObj, CopyObj, AlphaObj : HGDIOBJ;
+  PrevTextColor, PrevBkColor : COLORREF;
+  WinBmp: Windows.TBitmap;
+  Bmp, CopyBmp, AlphaBmp : HBITMAP;
+  HasAlpha: Boolean;
+  Blend: TBlendFunction;
+
+begin
+  Result := False;
+  //if Alpha = 0 then Exit;
+  // check if the Src has an alpha channel
+  Bmp := Windows.GetCurrentObject(SrcDC, OBJ_BITMAP);
+  // get info
+  HasAlpha := (Windows.GetObject(Bmp, SizeOf(WinBmp), @WinBmp) <> 0)
+          and (WinBmp.bmBitsPixel = 32)
+          and CreatePremultipliedBitmap(WinBmp, Bmp, AlphaBmp);
+
+  if HasAlpha then
+  begin
+    // premultiply pixels
+    AlphaDC := Windows.CreateCompatibleDC(SrcDC);
+    AlphaObj := Windows.SelectObject(AlphaDC, AlphaBmp);
+
+    // init blendfunction
+    Blend.BlendOp := AC_SRC_OVER;
+    Blend.BlendFlags := 0;
+    Blend.SourceConstantAlpha := 255;
+    Blend.AlphaFormat := AC_SRC_ALPHA;
+  end;
+
+  {$IfNDef WinCE}
+  Windows.SetStretchBltMode(DestDC, STRETCH_HALFTONE);
+  {$EndIf}
+  Windows.SetBrushOrgEx(DestDC, 0, 0, nil);
+  if Mask = 0 then
+  begin
+    if HasAlpha then
+    begin
+      Result := WinCEExtra.AlphaBlend(DestDC, X, Y, Width, Height, AlphaDC, 0, 0, SrcWidth, SrcHeight, Blend);
+    end
+    else
+    begin
+      if (Width = SrcWidth) and (Height = SrcHeight) then
+        Result := Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SRCCOPY)
+      else
+        Result := Windows.StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCCOPY);
+    end;
+  end
+  else
+  begin
+    MaskDC := Windows.CreateCompatibleDC(DestDC);
+    MaskObj := Windows.SelectObject(MaskDC, Mask);
+
+    PrevTextColor := Windows.SetTextColor(DestDC, $00000000);
+    PrevBkColor := Windows.SetBkColor(DestDC, $00FFFFFF);
+
+    if HasAlpha then
+    begin
+      // create copy of masked destination
+      CopyDC := Windows.CreateCompatibleDC(DestDC);
+      CopyBmp := Windows.CreateCompatibleBitmap(DestDC, Width, Height);
+      CopyObj := Windows.SelectObject(CopyDC, CopyBmp);
+      Windows.BitBlt(CopyDC, 0, 0, Width, Height, DestDC, X, Y, SRCCOPY);
+      // wipe non masked area -> white
+      Windows.SetTextColor(CopyDC, $00FFFFFF);
+      Windows.SetBkColor(CopyDC, $00000000);
+      if (Width = SrcWidth) and (Height = SrcHeight)
+      then Windows.BitBlt(CopyDC, 0, 0, Width, Height, MaskDC, XSrc, YSrc, SRCPAINT)
+      else Windows.StretchBlt(CopyDC, 0, 0, Width, Height, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCPAINT);
+
+      // copy source
+      WinCEExtra.AlphaBlend(DestDC, X, Y, Width, Height, AlphaDC, 0, 0, SrcWidth, SrcHeight, Blend);
+      // wipe masked area -> white
+      if (Width = SrcWidth) and (Height = SrcHeight)
+      then Windows.BitBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SRCPAINT)
+      else Windows.StretchBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCPAINT);
+
+      // paint copied destination
+      Windows.BitBlt(DestDC, X, Y, Width, Height, CopyDC, 0, 0, SRCAND);
+
+      // Restore stuff
+      Windows.SelectObject(CopyDC, CopyObj);
+      Windows.DeleteObject(CopyBmp);
+      Windows.DeleteDC(CopyDC);
+    end
+    else
+    begin
+      if (Width = SrcWidth) and (Height = SrcHeight) then
+      begin
+        Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SRCINVERT);
+        Windows.BitBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SRCAND);
+        Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SRCINVERT);
+      end
+      else
+      begin
+        Windows.StretchBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SrcWidth, SrcHeight, SRCINVERT);
+        Windows.StretchBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SrcWidth, SrcHeight, SRCAND);
+        Windows.StretchBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SrcWidth, SrcHeight, SRCINVERT);
+      end;
+    end;
+    Windows.SetTextColor(DestDC, PrevTextColor);
+    Windows.SetBkColor(DestDC, PrevBkColor);
+    Windows.SelectObject(MaskDC, MaskObj);
+    Windows.DeleteDC(MaskDC);
+  end;
+
+  if HasAlpha then
+  begin
+    Windows.SelectObject(AlphaDC, AlphaObj);
+    Windows.DeleteObject(AlphaBmp);
+    Windows.DeleteDC(AlphaDC);
+  end;
+
+  Result := true;
+end;
 {------------------------------------------------------------------------------
   Method:  TextOut
   Params: DC    - handle of device context

Ramin Jafari

2010-03-17 17:25

reporter   ~0035716

Last edited: 2010-03-17 18:42

Excuse me! Is this ok? :
1- change the sources
2- use TortoiseSVN-1.6.7.18415-win32-svn-1.6.9.msi
3- right click on c:\lazarus\my sub dir and click on SVN Checkout
4- URL of repository is "http://svn.freepascal.org/svn/lazarus/trunk/" and add my sub dir here
5- checkout dir is "c:\lazarus\" and add my sub dir here
6- press ok, press yes and wait to complete
7- right click on checkout dir and click on SVN Create patch
8- deselect all and select my files and create ...

i was created and attached it

Vincent Snijders

2010-03-18 12:49

manager   ~0035759

Yes, the format is correct. It would help the readability of the patch, if you just delete the code you don't use, instead of commenting it.

Ramin Jafari

2010-03-18 14:46

reporter   ~0035762

thank you

Felipe Monteiro de Carvalho

2010-03-19 04:34

developer   ~0035786

thanks, applied with some changes

Issue History

Date Modified Username Field Change
2010-02-22 07:08 Ramin Jafari New Issue
2010-02-22 07:08 Ramin Jafari Widgetset => WinCE
2010-03-01 15:04 Ramin Jafari Note Added: 0034879
2010-03-01 15:07 Ramin Jafari Note Added: 0034880
2010-03-01 15:08 Ramin Jafari Note Added: 0034881
2010-03-02 09:04 Andrzej Kałuża Note Added: 0034895
2010-03-08 14:32 Felipe Monteiro de Carvalho Status new => assigned
2010-03-08 14:32 Felipe Monteiro de Carvalho Assigned To => Felipe Monteiro de Carvalho
2010-03-09 13:40 Felipe Monteiro de Carvalho LazTarget => -
2010-03-09 13:40 Felipe Monteiro de Carvalho Note Added: 0035082
2010-03-09 13:40 Felipe Monteiro de Carvalho Status assigned => feedback
2010-03-09 18:25 Ramin Jafari Note Added: 0035089
2010-03-09 18:36 Ramin Jafari Note Edited: 0035089
2010-03-09 18:40 Ramin Jafari Note Edited: 0035089
2010-03-09 18:42 Ramin Jafari Note Edited: 0035089
2010-03-09 18:53 Ramin Jafari Note Edited: 0035089
2010-03-09 21:19 Felipe Monteiro de Carvalho Note Added: 0035106
2010-03-09 21:58 Felipe Monteiro de Carvalho Note Added: 0035109
2010-03-12 10:11 Vincent Snijders Relationship added has duplicate 0015811
2010-03-16 21:00 Ramin Jafari Note Added: 0035664
2010-03-16 21:06 Vincent Snijders Note Added: 0035665
2010-03-17 08:38 Ramin Jafari Note Added: 0035688
2010-03-17 09:40 Vincent Snijders Note Added: 0035691
2010-03-17 17:25 Ramin Jafari File Added: TWinCEWidgetSet-StretchMaskBlt.patch
2010-03-17 17:25 Ramin Jafari Note Added: 0035716
2010-03-17 17:29 Ramin Jafari Note Edited: 0035716
2010-03-17 18:42 Ramin Jafari Note Edited: 0035716
2010-03-18 12:49 Vincent Snijders Note Added: 0035759
2010-03-18 14:46 Ramin Jafari Note Added: 0035762
2010-03-19 04:34 Felipe Monteiro de Carvalho Fixed in Revision => 24093
2010-03-19 04:34 Felipe Monteiro de Carvalho Status feedback => resolved
2010-03-19 04:34 Felipe Monteiro de Carvalho Fixed in Version => 0.9.29 (SVN)
2010-03-19 04:34 Felipe Monteiro de Carvalho Resolution open => fixed
2010-03-19 04:34 Felipe Monteiro de Carvalho Note Added: 0035786
2010-05-01 14:38 Felipe Monteiro de Carvalho Relationship added related to 0015877
2011-12-01 11:23 Marc Weustink Status resolved => closed