unit CHILDWIN;

interface

uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, imagetype, bitmapimage, main,
  ExtCtrls ;

type
  TMDIChild = class(TForm)
    PaintBox: TPaintBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
  private
    { Private declarations }
    image_header : BITMAPV4HEADER ;
  public
    { Public declarations }
    image : bitmapimage.TBitmapImage ;
    ImageFormat : TImageType ;
    procedure ReadImage (Filename : String) ;
  end;

implementation

{$R *.dfm}

procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TMDIChild.ReadImage(Filename : String) ;
  Begin
  If Not Assigned (image) Then
    image := TBitmapImage.Create ;

  MainForm.ShowProgressBar ;
  Try
    ImageFormat := imagetype.ReadImage (Filename, image, ProgressFunction, Nil)
  Except Else
    image.Destroy ;
    image := Nil ;
    MainForm.ProgressBar.Visible := false ;
    Raise ;
    End ;

  image_header.bV4Size := sizeof (BITMAPV4HEADER) ;
  image_header.bV4Width := image.Width ;
  image_header.bV4Height := - image.Height ;
  image_header.bV4Planes := 1 ;
  image_header.bV4BitCount := 32 ;
  image_header.bV4V4Compression := BI_BITFIELDS ;
  image_header.bV4SizeImage := 0 ;
  image_header.bV4XPelsPerMeter := 0 ;
  image_header.bV4YPelsPerMeter := 0 ;
  image_header.bV4ClrUsed := 0 ;
  image_header.bV4ClrImportant := 0 ;
  image_header.bV4BlueMask := $FF ;
  image_header.bV4GreenMask := $FF00 ;
  image_header.bV4RedMask := $FF0000 ;
  image_header.bV4AlphaMask := $FF000000 ;

  MainForm.ProgressBar.Visible := false ;
  PaintBox.SetBounds (0, 0, image.Width, image.Height) ;
  End ;

procedure TMDIChild.FormCreate(Sender: TObject);
  begin
  ImageFormat := UnknownImage ;
  Image := Nil ;
  end;

procedure TMDIChild.FormDestroy(Sender: TObject);
  begin
  Image.Destroy ;
  end;

procedure TMDIChild.PaintBoxPaint(Sender: TObject);
var
  status : Integer ;
  header : ^BITMAPINFO ;
  msg : PChar ;
begin
  header := @image_header ;
  if Not Assigned (image) OR (ImageFormat = UnknownImage) Then
    exit ;
  status := SetDIBitsToDevice (PaintBox.Canvas.Handle,
                     0,
                     0,
                     image.Width,
                     image.Height,
                     0,
                     0,
                     0,
                     image.Height,
                     Pointer (@image.Pixels [0]),
                     header^,
                     DIB_RGB_COLORS) ;

  if status = 0 then
    Begin
    FormatMessage(
      FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM,
      Nil,
      GetLastError(),
      0, /// MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
      @msg,
      0,
      Nil) ;

    // Display the string.
    Windows.MessageBox(0, msg, 'GetLastError', MB_OK OR MB_ICONINFORMATION );

    // Free the buffer.
    Windows.LocalFree (HLOCAL (msg)) ;

    End ;
end;

end.
