How to load and display a jpg/jpeg image on ppc

[rezor]

Hello,
I have an application using KOL-CE and compiled for ARM pocket pcs.
I need to display a jpg image.
My target is PPC2003, Windows Mobile 5, Windows Mobile 6.

Currently I can show a .2bp file using the following code in the onPaint event of the KOLPaintBox component:

Code: [Select]


procedure TfMain.bBackgroundPaint(sender: pcontrol; DC: HDC);
var     BitMap:pBitmap; aRect: tRect;
begin
        BitMap:=NewBitMap(0,0);
Bitmap^.LoadfromFile('test.2bp');
        aRect.Left:= 0;
        aRect.Top := 0;
        aRect.Right := sender^.width;
        aRect.Bottom := sender^.height;
        Bitmap.StretchDraw (DC,aRect);
end;      


I considered using the windows api
function SHLoadImageFile(pszFileName: LPCTSTR ) : HBITMAP; external 'imgdecmp.dll' name 'SHLoadImageFile';
but it seems this is not available on al ppcs, especially recent ones.
If the dll is not present the application will not load at all. So this is another option to rule out.

Finally, it seems nearly all pocket pcs currently available support Imaging Factory, http://ce4all.blogspot.com/2007/06/using-image-factory-under-cewindows.html
so this code could help (but first we need to port it to pascal):

Code: [Select]


CoInitializeEx(NULL, 0);
IImagingFactory* pImageFactory;
IImage *pImage = NULL;

HDC dc = GetDC(0); // insert your window handle here, else this is the desktop

HRESULT hr = CoCreateInstance(CLSID_ImagingFactory, NULL,
CLSCTX_INPROC_SERVER,
__uuidof(IImagingFactory),
(LPVOID *)&pImageFactory);

// Load image from file
pImageFactory->CreateImageFromFile(bitmapName, &pImage);

// Get image information
ImageInfo info;
pImage->GetImageInfo(&info);

RECT rc={0,0,info.Width, info.Height};

// draw jpg/gif etc onto temp dc
pImage->Draw(dc, &rc, NULL);

// Clean up
pImage->Release();
pImageFactory->Release();

CoUninitialize();


If someone can help with the code, I can test on several pocket pcs.

[Leledumbo]

Don't know whether this will work or not:
Add ImagesForLazarus (install first, it's not installed by default. Find it under components directory) as one of your project's dependency (Project->Project Inspector->Add->New Requirement->Package Name), then add LazJPG as one of your unit in uses clause. Now TPicture.LoadFromFile can be used to load JPEG files.

[rezor]

Thank you Leledumbo,
I did it and rebuilt Lazarus, however when I add a TPicture I get "Identifier not found" error. I have Graphics in my uses list and I get code completion in the IDE for tPicture... it's there at designtime but it won't compile.
I fear this may be a problem with KOL-CE or windows CE in general.
Do you have any advice?

[rezor]

Ok managed it, however
a) the graphics unit makes my app 1mb bigger
b) the application compiles but doesn't load on the device.
I believe kol and lcl are incompatible

[rezor]

Solution: use KOL imagedecompress
This solution come right from http://www.delphimaster.ru/cgi-bin/forum.pl?id=1193132694&n=10

The unit imageDecompress is available from kolnmck:
http://www.kolnmck.ru/files/components/graphics/imagedecompress.7z
You will need to remove the line "uses Textout;".

To test it:

1. Add a global var to hold the image, and uses clause

Code: [Select]


uses Window, KOL, ..., ImageDecompress,


var image: pImageDecompress;


2. in some initialization procedure, such as formcreate, put

Code: [Select]


var fn: string;
begin
fn := extractFilePath(paramstr(0))+'background.jpg';
        image:= NewImageDecompress;
image.LoadFromFile(fn);


3. In the onPaint event of a control write

Code: [Select]


procedure TfMain.bBackgroundPaint(sender: pcontrol; DC: HDC);
const backcols : array[0..3] of tColor = (clTeal, clRed, clBlue, clYellow);
var aRect: tRect; fn: string;
begin
    aRect.Left:= 0;
    aRect.Top := 0;
    aRect.Right  := aRect.left + sender^.width;
    aRect.Bottom := aRect.top +  sender^.height;
   
    if image<> nil then
image.Bitmap.StretchDraw (DC, aRect)
    else
        with pcontrol(sender).canvas^ do
        begin
randomize;
            brush.color := backcols[random(4)];
            brush.BrushStyle:=bsSolid;
            FillRect(aRect);
        end;
end;


This has been tested on Windows Mobile 5 and PPC 2003, with both jpg and gif images.



I am attaching here the version of imageDecompress I used:
imageDecompress.pas

Code: [Select]


{$ifdef FPC} {$mode delphi} {$endif}
unit ImageDecompress;


//The following formats are supported: BMP, GIF, JPG, PNG, XBM

interface

uses Windows, KOL;

type
  TProgressFunc = procedure(pRender: Pointer; bComplete: BOOL; lParam: LPARAM); stdcall;
  TGetDataFunc = function(szBuffer: Pointer; dwBufferMax: DWORD; lParam: LPARAM): DWORD; stdcall;

  TDecompressImageInfo = record
    dwSize: DWORD;                    // Size of this structure
    pbBuffer: Pointer;                 // Pointer to the buffer to use for data
    dwBufferMax: DWORD;               // Size of the buffer
    dwBufferCurrent: DWORD;           // The amount of data which is current in the buffer
    phBM: Pointer;                    // Pointer to the bitmap returned (can be NULL)
    ppImageRender: Pointer;           // Pointer to an IImageRender object (can be NULL)
    iBitDepth: longint;               // Bit depth of the output image
    lParam: LPARAM;                   // User parameter for callback functions
    hdc: HDC;                         // HDC to use for retrieving palettes
    iScale: LongInt;                  // Scale factor (1 - 100)
    iMaxWidth: LongInt;               // Maximum width of the output image
    iMaxHeight: LongInt;              // Maxumum height of the output image
    pfnGetData: TGetDataFunc;         // Callback function to get more data
    pfnImageProgress: TProgressFunc;  // Callback function to notify caller of progress decoding the image
    crTransparentOverride: COLORREF;  // If this color is not (UINT)-1, it will override the transparent color in the image with this color. (GIF ONLY)
  end;


  { TImageDecompress }

  PImageDecompress = ^TImageDecompress;

  {$Ifdef ShowProgressImage} TOnProgressImage = procedure(Sender: PImageDecompress; MaxProgress, Progress: DWORD) of object; {$endif}
  TImageDecompress = object(TObj)
  private
    FBitmap: PBitmap;
    {$Ifdef ShowProgressImage} FOnProgressImage: TOnProgressImage; {$endif}
    FStreamSize, FCurPos: Integer;
    FDecompressImageInfo: TDecompressImageInfo;
    FInputStream: PStream;
    procedure SetBufSize(const Value: DWORD);
  public
    destructor Destroy; virtual;

    function LoadFromFile(FileName: KOLString): Boolean;
    function LoadFromStream(Stream: PStream; Size: Integer = -1): Boolean;
    function LoadFromResource(Instance: Integer; Rsrc: PKOLChar; ResType: PKOLChar): Boolean;
    function LoadFromMemory(Data: Pointer; Size: Integer): Boolean;

    // Bit depth of the output image
    property BitsPerPixel: LongInt write FDecompressImageInfo.iBitDepth;
    // Scale factor (1 - 100)
    property Scale: LongInt write FDecompressImageInfo.iScale;
    // Maximum width of the output image
    property MaxWidth: LongInt write FDecompressImageInfo.iMaxWidth;
    // Maxumum height of the output image
    property MaxHeight: LongInt write FDecompressImageInfo.iMaxHeight;
    // If this color is not (UINT)-1, it will override the transparent color in the image with this color. (GIF ONLY)
    property TransparentOverride: COLORREF write FDecompressImageInfo.crTransparentOverride;

    property BufSize: DWORD read FDecompressImageInfo.dwBufferMax write SetBufSize;
    property Bitmap: PBitmap read FBitmap write FBitmap;
    {$Ifdef ShowProgressImage} property OnProgressImage: TOnProgressImage read FOnProgressImage write FOnProgressImage; {$endif}
  end;
  function NewImageDecompress: PImageDecompress;

implementation

//uses TextOut;

function DecompressImageIndirect(pParams: Pointer): HRESULT; stdcall; external 'imgdecmp' name 'DecompressImageIndirect';

function LoadImage(Buffer: Pointer; dwBufferMax: DWORD; lParam: LPARAM) : DWORD; stdcall;
var ImageDecompress: PImageDecompress;

begin
    ImageDecompress:= PImageDecompress(lParam);
    Result:= Min(ImageDecompress.FCurPos, dwBufferMax);
    if Result > 0 then ImageDecompress.FInputStream.Read(Buffer^, Result);
    ImageDecompress.FCurPos:= ImageDecompress.FCurPos - Result;

    {$Ifdef ShowProgressImage} if Assigned(ImageDecompress.FOnProgressImage) then ImageDecompress.FOnProgressImage(ImageDecompress, ImageDecompress.FStreamSize, ImageDecompress.FStreamSize-ImageDecompress.FCurPos); {$endif}
end;
procedure LoadImageProgress(pRender: Pointer; bComplete: BOOL; lparam: LPARAM); stdcall;
begin
   // We don't care about the load progress...
//   ShowMessage('Progr');
end;

function NewImageDecompress: PImageDecompress;
begin
    New(Result, Create);
    with Result.FDecompressImageInfo do begin
       dwSize                := SizeOf(TDecompressImageInfo);
       phBM                  := @Result;
       ppImageRender         := nil;
       iBitDepth             := 16;
       lParam                := Integer(Result);
       hdc                   := 0;
       iScale                := 100;
       iMaxWidth             := 8192;
       iMaxHeight            := 8192;
       pfnGetData            := LoadImage;
       pfnImageProgress      := nil;//LoadImageProgress;
       crTransparentOverride := UINT(-1);
       dwBufferMax:= 0;
       pbBuffer:= nil;
    end;
end;

{ TImageDecompress }

procedure TImageDecompress.SetBufSize(const Value: DWORD);
begin
    if FDecompressImageInfo.dwBufferMax <> Value then begin
      if FDecompressImageInfo.pbBuffer <> nil then FreeMem(FDecompressImageInfo.pbBuffer);
      if Value > 0 then GetMem(FDecompressImageInfo.pbBuffer, Value);
      FDecompressImageInfo.dwBufferMax:= Value;
    end;
end;

destructor TImageDecompress.Destroy;
begin
    if FBitmap <> nil then FBitmap.Free;
    BufSize:= 0;
    inherited;
end;

function TImageDecompress.LoadFromFile(FileName: KOLString): Boolean;
begin
    FInputStream:= NewReadFileStream(FileName);
    try
      Result:= LoadFromStream(FInputStream);
    finally
      FInputStream.Free;
    end;
end;

function TImageDecompress.LoadFromStream(Stream: PStream; Size: Integer = -1): Boolean;
var hBmp: HBITMAP;
begin
    if Size < 0 then FStreamSize:= Stream.Size - Stream.Position
    else FStreamSize:= Size;
    if FStreamSize <= 0 then Exit;
    FInputStream:= Stream;
    {$Ifdef ShowProgressImage} if Assigned(FOnProgressImage) then FOnProgressImage(@Self, FStreamSize, 0); {$endif}
    hBmp:= 0;
    FDecompressImageInfo.dwBufferCurrent:= 0;
    FDecompressImageInfo.phBM:= @hBmp;
    if FDecompressImageInfo.dwBufferMax <= 0 then BufSize:= FStreamSize;
    FCurPos:= FStreamSize;
   
    Result:= (DecompressImageIndirect(@FDecompressImageInfo) >= 0) and (hBmp <> 0);
   
    if Result then begin
      if FBitmap = nil then FBitmap:= NewBitmap(0, 0);
      FBitmap.Clear;
      FBitmap.Handle:= hBmp;
    end;
    {$Ifdef ShowProgressImage} if Assigned(FOnProgressImage) then FOnProgressImage(@Self, FStreamSize, FStreamSize); {$endif}
end;

function TImageDecompress.LoadFromResource(Instance: Integer; Rsrc: PKOLChar; ResType: PKOLChar): Boolean;
var Stream: PStream;
begin
    Result:= False;
    Stream:= NewMemoryStream;
    try
      if Resource2Stream(Stream, Instance, Rsrc, ResType) = 0 then Exit;
      Stream.Position:= 0;
      Result:= LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
end;

function TImageDecompress.LoadFromMemory(Data: Pointer; Size: Integer): Boolean;
var _Buf: Pointer;
    _BufSize: DWORD;
begin
    FInputStream:= NewExMemoryStream(Data, Size);
    try
      _Buf:= FDecompressImageInfo.pbBuffer;
      _BufSize:= FDecompressImageInfo.dwBufferMax;

      FDecompressImageInfo.pbBuffer:= Data;
      FDecompressImageInfo.dwBufferMax:= Size;

      Result:= LoadFromStream(FInputStream, Size);
    finally
      FDecompressImageInfo.pbBuffer:= _Buf;
      FDecompressImageInfo.dwBufferMax:= _BufSize;
      FInputStream.Free;
    end;
end;

end.