source: trunk/FormMain.pas

unit FormMain;

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;

type

  { TFormMain }

  TFormMain = class(TForm)
    MemoLog: TMemo;
    procedure FormShow(Sender: TObject);
  private

  public
    procedure ProcessImage(InputFileName, OutputFileName: string);
  end;

var
  FormMain: TFormMain;


implementation

{$R *.lfm}

{ TFormMain }

procedure TFormMain.FormShow(Sender: TObject);
begin
  MemoLog.Lines.Clear;
  ProcessImage('Input.png', 'Output.zip');
  MemoLog.Lines.Add('Finished');
end;

procedure TFormMain.ProcessImage(InputFileName, OutputFileName: string);
var
  Image: TImage;
  F: TFileStream;
  Buffer: array of Byte;
  Offset: TPoint;
  X, Y: Integer;
  Pixel: Cardinal;
  Line: PColor;
  I: Integer;
  S: Integer;
begin
  Image := TImage.Create(nil);
  Image.Picture.LoadFromFile(InputFileName);
  Offset := Point(0, 100);

  F := TFileStream.Create(OutputFileName, fmOpenWrite or fmCreate);
  SetLength(Buffer, Image.Picture.Bitmap.Width * Image.Picture.Bitmap.Height * 4);
  X := Offset.X;
  Y := Offset.Y;
  I := 0;
  Line := Image.Picture.Bitmap.ScanLine[Y];
  Pixel := PColor(Line + X)^ and $ffffff;
  Inc(Y);
  S := ((Pixel shr 16) and $ff) or (Pixel and $ff00) or (((Pixel shr 0) and $ff) shl 16);
  SetLength(Buffer, S);
  Inc(Y);
  while Y < Image.Picture.Bitmap.Height do begin
    Line := Image.Picture.Bitmap.ScanLine[Y];
    X := Offset.X;
    while X < Image.Picture.Bitmap.Width do begin
      Pixel := PColor(Line + X)^;
      Buffer[I] := (((Pixel shr 20) and $f) shl 0) or
        (((Pixel shr 12) and $f) shl 4);
      Inc(X, 2);
      Inc(I, 1);
      if I >= Length(Buffer) then Break;
    end;
    if I >= Length(Buffer) then Break;
    Inc(Y, 2);
  end;

  F.Write(Buffer[0], Length(Buffer));
  F.Size := Length(Buffer);
  F.Free;
  Image.Free;
end;

end.