wince:

- port some win32 graphic fixes
  - add CreateDIBSectionFromDDB since GetDIBits is not exits on wince
  - fix GetBitmapBytes - now it can retrieve bytes from the DDB
(#0011911)
  

git-svn-id: trunk@16341 -

lcl/imglist.pp

@@ -101,8 +101,6 @@ type
   
   // Some temp rework defines, for old functionality both need so be set
 
-  {.$define IMGLIST_KEEP_EXTRA}   // Not needed for Delphi compat.
-
   TDrawingStyle = (dsFocus, dsSelected, dsNormal, dsTransparent);
   TImageType = (itImage, itMask);
 

lcl/interfaces/wince/winceint.pp

@@ -26,7 +26,7 @@ unit WinCEInt;
 
 {$mode objfpc}{$H+}
 
-Interface
+interface
 
 { At least FPC 2.2.1 is required if the architecture is ARM
   FPC 2.0 or inferior isn't checked because it can't compile for wince }
@@ -48,12 +48,15 @@ Interface
   When editing this unit list, be sure to keep Windows listed first to ensure
   successful compilation.
 }
-Uses
+uses
   // Compatibility
-  {$ifdef Win32}win32compat,{$endif}
+  {$ifdef Win32}
+    win32compat,
+  {$else}
+    aygshell,
+  {$endif}
   // Libs
   Windows,
-  {$ifndef win32}aygshell,{$endif}
   // RTL, LCL
   Classes, ComCtrls, Controls, Buttons, Dialogs, DynHashArray,
   ExtCtrls, Forms, GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType,

lcl/interfaces/wince/wincelclintf.inc

@@ -69,43 +69,40 @@ end;
 
  ------------------------------------------------------------------------------}
 function TWinceWidgetSet.RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean): Boolean;
-
-  function GetMask(APrec, AShift: Byte): Cardinal;
-  begin
-    Result := ($FFFFFFFF shr (32-APrec)) shl AShift;
-  end;
-
 var
   ADesc: TRawImageDescription absolute ARawImage.Description;
   DC: HDC;
-  Info: record
-    Header: Windows.TBitmapInfoHeader;
-    Colors: array[0..3] of Cardinal; // reserve extra color for colormasks
-  end;
   BitsPtr: Pointer;
-  DataSize: Integer;
+  DataSize: PtrUInt;
 begin
-  DC := Windows.GetDC(0);
+  Result := False;
   AMask := 0;
-  ABitmap := CreateDIBSectionFromDescription(DC, ADesc, BitsPtr);
-  //DbgDumpBitmap(ABitmap, 'CreateBitmaps - Image');
-  Windows.ReleaseDC(0, DC);
 
-  Result := ABitmap <> 0;
-  if not Result then Exit;
-  if BitsPtr = nil then Exit;
+  if not ((ADesc.BitsPerPixel = 1) and (ADesc.LineEnd = rileWordBoundary)) then
+  begin
+    DC := Windows.GetDC(0);
+    AMask := 0;
+    ABitmap := CreateDIBSectionFromDescription(DC, ADesc, BitsPtr);
+    //DbgDumpBitmap(ABitmap, 'CreateBitmaps - Image');
+    Windows.ReleaseDC(0, DC);
 
-  // copy the image data
-  DataSize := BytesPerLine(ADesc.Width, ADesc.BitsPerPixel) * ADesc.Height;
-  if DataSize > ARawImage.DataSize
-  then DataSize := ARawImage.DataSize;
-  Move(ARawImage.Data^, BitsPtr^, DataSize);
+    Result := ABitmap <> 0;
+    if not Result then Exit;
+    if BitsPtr = nil then Exit;
 
-  if ASkipMask then Exit;
-  if ARawImage.Mask = nil then Exit;
-  if ARawImage.MaskSize = 0 then Exit;
+    // copy the image data
+    DataSize := BytesPerLine(ADesc.Width, ADesc.BitsPerPixel) * ADesc.Height;
+    if DataSize > ARawImage.DataSize
+    then DataSize := ARawImage.DataSize;
+    Move(ARawImage.Data^, BitsPtr^, DataSize);
+  end
+  else
+    ABitmap := Windows.CreateBitmap(ADesc.Width, ADesc.Height, 1, 1, ARawImage.Data);
+
+  if ASkipMask then Exit(True);
 
   AMask := Windows.CreateBitmap(ADesc.Width, ADesc.Height, 1, 1, ARawImage.Mask);
+  //DbgDumpBitmap(ABitmap, 'CreateBitmaps - Mask');
   Result := AMask <> 0;
 end;
 
@@ -223,6 +220,7 @@ begin
     if not Result then exit;
 
     Result := GetBitmapBytes(AMask, R, ARawImage.Description.MaskLineEnd, ARawImage.Mask, ARawImage.MaskSize);
+    //DebugLn(Format('AMask = %d, MaskSize = %d, Mask = %d, Result = %s', [AMask, ARawImage.MaskSize, PtrUInt(ARawImage.Mask), BoolToStr(Result)]));
   end
   else begin
     ARawImage.Description.MaskBitsPerPixel := 0;;
@@ -310,10 +308,47 @@ end;
   Returns:
 
  ------------------------------------------------------------------------------}
-//function TWinceWidgetSet.RawImage_QueryDescription(AFlags: TRawImageQueryFlags; var ADesc: TRawImageDescription): Boolean;
-//begin
-//  // override only when queried formats are different from screen description
-//end;
+function TWinceWidgetSet.RawImage_QueryDescription(AFlags: TRawImageQueryFlags; var ADesc: TRawImageDescription): Boolean;
+begin
+  if riqfAlpha in AFlags
+  then begin
+    //always return rgba description
+    if not (riqfUpdate in AFlags)
+    then ADesc.Init;
+
+    ADesc.Format := ricfRGBA;
+    ADesc.Depth := 32;
+    ADesc.BitOrder := riboReversedBits;
+    ADesc.ByteOrder := riboLSBFirst;
+    ADesc.LineOrder := riloTopToBottom;
+    ADesc.LineEnd := rileDWordBoundary;
+    ADesc.BitsPerPixel := 32;
+
+    ADesc.AlphaPrec := 8;
+    ADesc.AlphaShift := 24;
+
+    if riqfRGB in AFlags
+    then begin
+      ADesc.RedPrec := 8;
+      ADesc.GreenPrec := 8;
+      ADesc.BluePrec := 8;
+      ADesc.RedShift := 16;
+      ADesc.GreenShift := 8;
+      ADesc.BlueShift := 0;
+    end;
+    
+    AFlags := AFlags - [riqfRGB, riqfAlpha, riqfUpdate];
+    if AFlags = [] then Exit(True);
+    
+    // continue with default
+    Include(AFlags, riqfUpdate);
+  end;
+
+  Result := inherited RawImage_QueryDescription(AFlags, ADesc);
+  // reduce mem
+  if Result and (ADesc.Depth = 24) 
+  then ADesc.BitsPerPixel := 24;
+end;
 
 procedure TWinCEWidgetSet.RemoveEventHandler(var AHandler: PEventHandler);
 var

lcl/interfaces/wince/wincelclintfh.inc

@@ -49,7 +49,7 @@ function RawImage_DescriptionFromDevice(ADC: HDC; out ADesc: TRawImageDescriptio
 function RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; ARect: PRect = nil): Boolean; override;
 function RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean; override;
 // override only when queried formats are different from screen description
-//function RawImage_QueryDescription(AFlags: TRawImageQueryFlags; var ADesc: TRawImageDescription): Boolean; override;
+function RawImage_QueryDescription(AFlags: TRawImageQueryFlags; var ADesc: TRawImageDescription): Boolean; override;
 
 procedure RemoveEventHandler(var AHandler: PEventHandler); override;
 procedure RemovePipeEventHandler(var AHandler: PPipeEventHandler); override;

lcl/interfaces/wince/winceproc.pp

@@ -60,7 +60,7 @@ function DeliverMessage(const Target: Pointer; var Message): Integer;
 function DeliverMessage(const Target: TObject; var Message: TLMessage): Integer;
 function ObjectToHWND(Const AObject: TObject): HWND;
 
-function BytesPerLine(nWidth, nBitsPerPixel: Integer): Integer;
+function BytesPerLine(nWidth, nBitsPerPixel: Integer): PtrUInt;
 function CreateDIBSectionFromDescription(ADC: HDC; const ADesc: TRawImageDescription; out ABitsPtr: Pointer): HBITMAP;
 procedure FillRawImageDescriptionColors(var ADesc: TRawImageDescription);
 procedure FillRawImageDescription(const ABitmapInfo: Windows.TBitmap; out ADesc: TRawImageDescription);
@@ -614,7 +614,7 @@ Begin
     Assert (False, 'Trace:[ObjectToHWND]****** Warning: handle = 0 *******');
 end;
 
-function BytesPerLine(nWidth, nBitsPerPixel: Integer): Integer;
+function BytesPerLine(nWidth, nBitsPerPixel: Integer): PtrUInt;
 begin
   Result := ((nWidth * nBitsPerPixel + 31) and (not 31) ) div 8;
 end;
@@ -724,7 +724,9 @@ begin
   Info.Header.biClrImportant := 0;
   Info.Header.biSizeImage := BytesPerLine(Info.Header.biWidth, Info.Header.biBitCount) * ADesc.Height;
   // CE only supports bitfields
-  Info.Header.biCompression := BI_BITFIELDS;
+  if ADesc.BitsPerPixel > 8
+  then Info.Header.biCompression := BI_BITFIELDS
+  else Info.Header.biCompression := BI_RGB;
 
   // when 24bpp, CE only supports B8G8R8 encoding
   // TODO: check the description
@@ -739,10 +741,45 @@ begin
   //DbgDumpBitmap(Result, 'CreateDIBSectionFromDescription - Image');
 end;
 
+function CreateDIBSectionFromDDB(ASource: HBitmap; out ABitsPtr: Pointer): HBitmap;
+var
+  ADC, SrcDC, DstDC: HDC;
+  ADesc: TRawImageDescription;
+  SrcOldBm, DstOldBm: HBitmap;
+begin
+  Result := 0;
+
+  // get source bitmap description
+  if not RawImage_DescriptionFromBitmap(ASource, ADesc) then
+    Exit;
+
+  // create apropriate dib section
+  ADC := GetDC(0);
+  Result := CreateDIBSectionFromDescription(ADC, ADesc, ABitsPtr);
+  ReleaseDC(0, ADC);
+
+  if Result = 0 then
+    Exit;
+
+  // copy source bitmap into destination
+  SrcDC := CreateCompatibleDC(0);
+  SrcOldBm := SelectObject(SrcDC, ASource);
+  DstDC := CreateCompatibleDC(0);
+  DstOldBm := SelectObject(DstDC, Result);
+  Windows.BitBlt(DstDC, 0, 0, ADesc.Width, ADesc.Height, SrcDC, 0, 0, SRCCOPY);
+  SelectObject(SrcDC, SrcOldBm);
+  SelectObject(DstDC, DstOldBm);
+  DeleteDC(SrcDC);
+  DeleteDC(DstDC);
+end;
+
 function GetBitmapBytes(ABitmap: HBITMAP; const ARect: TRect; ALineEnd: TRawImageLineEnd; var AData: Pointer; var ADataSize: PtrUInt): Boolean;
 var
   Section: Windows.TDIBSection;
+  DIBCopy: HBitmap;
+  DIBData: Pointer;
 begin
+  Result := False;
   // first try if the bitmap is created as section
   if (Windows.GetObject(ABitmap, SizeOf(Section), @Section) > 0) and (Section.dsBm.bmBits <> nil)
   then begin
@@ -753,9 +790,18 @@ begin
   
   // bitmap is not a section, retrieve only bitmap
   if Windows.GetObject(ABitmap, SizeOf(Section.dsBm), @Section) = 0
-  then Exit(False);
+  then Exit;
 
-  {$note TODO: create copy bitmap to section and use bits}
+  DIBCopy := CreateDIBSectionFromDDB(ABitmap, DIBData);
+  if DIBCopy = 0 then
+    Exit;
+  if (Windows.GetObject(DIBCopy, SizeOf(Section), @Section) > 0) and (Section.dsBm.bmBits <> nil)
+  then begin
+    with Section.dsBm do
+      Result := CopyImageData(bmWidth, bmHeight, bmWidthBytes, bmBitsPixel, bmBits, ARect, riloTopToBottom, riloTopToBottom, ALineEnd, AData, ADataSize);
+  end;
+
+  DeleteObject(DIBCopy);
 
   Result := True;
 end;