1 | unit UFormMain;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
|
---|
7 |
|
---|
8 | type
|
---|
9 |
|
---|
10 | { TFormMain }
|
---|
11 |
|
---|
12 | TFormMain = class(TForm)
|
---|
13 | MemoLog: TMemo;
|
---|
14 | procedure FormShow(Sender: TObject);
|
---|
15 | private
|
---|
16 |
|
---|
17 | public
|
---|
18 | procedure ProcessImage(InputFileName, OutputFileName: string);
|
---|
19 | end;
|
---|
20 |
|
---|
21 | var
|
---|
22 | FormMain: TFormMain;
|
---|
23 |
|
---|
24 | implementation
|
---|
25 |
|
---|
26 | {$R *.lfm}
|
---|
27 |
|
---|
28 | { TFormMain }
|
---|
29 |
|
---|
30 | procedure TFormMain.FormShow(Sender: TObject);
|
---|
31 | begin
|
---|
32 | MemoLog.Lines.Clear;
|
---|
33 | ProcessImage('Input.png', 'Output.zip');
|
---|
34 | MemoLog.Lines.Add('Finished');
|
---|
35 | end;
|
---|
36 |
|
---|
37 | procedure TFormMain.ProcessImage(InputFileName, OutputFileName: string);
|
---|
38 | var
|
---|
39 | Image: TImage;
|
---|
40 | F: TFileStream;
|
---|
41 | Buffer: array of Byte;
|
---|
42 | Offset: TPoint;
|
---|
43 | X, Y: Integer;
|
---|
44 | Pixel: Cardinal;
|
---|
45 | Line: PColor;
|
---|
46 | I: Integer;
|
---|
47 | S: Integer;
|
---|
48 | begin
|
---|
49 | Image := TImage.Create(nil);
|
---|
50 | Image.Picture.LoadFromFile(InputFileName);
|
---|
51 | Offset := Point(0, 100);
|
---|
52 |
|
---|
53 | F := TFileStream.Create(OutputFileName, fmOpenWrite or fmCreate);
|
---|
54 | SetLength(Buffer, Image.Picture.Bitmap.Width * Image.Picture.Bitmap.Height * 4);
|
---|
55 | X := Offset.X;
|
---|
56 | Y := Offset.Y;
|
---|
57 | I := 0;
|
---|
58 | Line := Image.Picture.Bitmap.ScanLine[Y];
|
---|
59 | Pixel := PColor(Line + X)^ and $ffffff;
|
---|
60 | Inc(Y);
|
---|
61 | S := ((Pixel shr 16) and $ff) or (Pixel and $ff00) or (((Pixel shr 0) and $ff) shl 16);
|
---|
62 | SetLength(Buffer, S);
|
---|
63 | Inc(Y);
|
---|
64 | while Y < Image.Picture.Bitmap.Height do begin
|
---|
65 | //Line := PColor(Image.Picture.Bitmap.RawImage.Data +
|
---|
66 | //Image.Picture.Bitmap.Height * Image.Picture.Bitmap.RawImage.Description.BytesPerLine -
|
---|
67 | //Y * Image.Picture.Bitmap.RawImage.Description.BytesPerLine);
|
---|
68 | Line := Image.Picture.Bitmap.ScanLine[Y];
|
---|
69 | X := Offset.X;
|
---|
70 | while X < Image.Picture.Bitmap.Width do begin
|
---|
71 | Pixel := PColor(Line + X)^;
|
---|
72 | // Buffer[I] := //((Pixel shr 21) and $7) or
|
---|
73 | // (((Pixel shr 12) and $f) shl 4) or
|
---|
74 | // (((Pixel shr 4) and $f) shl 0);
|
---|
75 | Buffer[I] := (((Pixel shr 20) and $f) shl 0) or
|
---|
76 | (((Pixel shr 12) and $f) shl 4);
|
---|
77 | Inc(X, 2);
|
---|
78 | //Buffer[I + 1] := (Pixel shr 8) and $ff;
|
---|
79 | //Buffer[I + 2] := (Pixel shr 0) and $ff;
|
---|
80 | Inc(I, 1);
|
---|
81 | if I >= Length(Buffer) then Break;
|
---|
82 | end;
|
---|
83 | if I >= Length(Buffer) then Break;
|
---|
84 | Inc(Y, 2);
|
---|
85 | end;
|
---|
86 |
|
---|
87 | F.Write(Buffer[0], Length(Buffer));
|
---|
88 | F.Size := Length(Buffer);
|
---|
89 | F.Free;
|
---|
90 | Image.Free;
|
---|
91 | end;
|
---|
92 |
|
---|
93 | end.
|
---|
94 |
|
---|