1 | unit UMethodGraphics32;
|
---|
2 |
|
---|
3 | {$mode delphi}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, UFastBitmap, UDrawMethod,
|
---|
9 | {$IFDEF GRAPHICS32}GR32, GR32_Image,{$ENDIF}
|
---|
10 | Controls, Graphics;
|
---|
11 |
|
---|
12 | {$IFDEF GRAPHICS32}
|
---|
13 | type
|
---|
14 | { TMethodGraphics32 }
|
---|
15 |
|
---|
16 | TMethodGraphics32 = class(TDrawMethod)
|
---|
17 | Image: TImage32;
|
---|
18 | constructor Create; override;
|
---|
19 | destructor Destroy; override;
|
---|
20 | procedure DrawFrame(FastBitmap: TFastBitmap); override;
|
---|
21 | procedure Init(Parent: TWinControl; Size: TPoint; PixelFormat: TPixelFormat); override;
|
---|
22 | procedure Done; override;
|
---|
23 | end;
|
---|
24 | {$ENDIF}
|
---|
25 |
|
---|
26 | implementation
|
---|
27 |
|
---|
28 | {$IFDEF GRAPHICS32}
|
---|
29 | { TMethodGraphics32 }
|
---|
30 |
|
---|
31 | constructor TMethodGraphics32.Create;
|
---|
32 | begin
|
---|
33 | inherited Create;
|
---|
34 | Caption := 'TGR32Image';
|
---|
35 | Description.Add('Graphics32 is well implemented highly optimized Delphi graphic ' +
|
---|
36 | 'library also ported to Lazarus/LCL. It uses static 32-bit wide pixel:');
|
---|
37 | Description.Add('TColor32Entry = packed record');
|
---|
38 | Description.Add(' case Integer of');
|
---|
39 | Description.Add(' 0: (B, G, R, A: Byte);');
|
---|
40 | Description.Add(' 1: (ARGB: TColor32);');
|
---|
41 | Description.Add(' 2: (Planes: array[0..3] of Byte);');
|
---|
42 | Description.Add(' 3: (Components: array[TColor32Component] of Byte);');
|
---|
43 | Description.Add('end;');
|
---|
44 | end;
|
---|
45 |
|
---|
46 | destructor TMethodGraphics32.Destroy;
|
---|
47 | begin
|
---|
48 | inherited Destroy;
|
---|
49 | end;
|
---|
50 |
|
---|
51 | procedure TMethodGraphics32.DrawFrame(FastBitmap: TFastBitmap);
|
---|
52 | var
|
---|
53 | Y, X: Integer;
|
---|
54 | PixelPtr: PColor32;
|
---|
55 | RowPtr: PColor32;
|
---|
56 | ImagePtr: PColor32;
|
---|
57 | BytePerPixel: Integer;
|
---|
58 | BytePerRow: Integer;
|
---|
59 | begin
|
---|
60 | with FastBitmap do
|
---|
61 | try
|
---|
62 | Image.Bitmap.BeginUpdate;
|
---|
63 | BytePerPixel := 4;
|
---|
64 | BytePerRow := 4 * Image.Bitmap.Width;
|
---|
65 | ImagePtr := Image.Bitmap.PixelPtr[0, 0];
|
---|
66 | RowPtr := ImagePtr;
|
---|
67 | for Y := 0 to Size.Y - 1 do begin
|
---|
68 | PixelPtr := RowPtr;
|
---|
69 | for X := 0 to Size.X - 1 do begin
|
---|
70 | PixelPtr^ := Pixels[X, Y];
|
---|
71 | Inc(PByte(PixelPtr), BytePerPixel);
|
---|
72 | end;
|
---|
73 | Inc(PByte(RowPtr), BytePerRow);
|
---|
74 | end;
|
---|
75 | finally
|
---|
76 | Image.Bitmap.EndUpdate;
|
---|
77 | end;
|
---|
78 | Image.Repaint;
|
---|
79 | end;
|
---|
80 |
|
---|
81 | procedure TMethodGraphics32.Init(Parent: TWinControl; Size: TPoint; PixelFormat: TPixelFormat);
|
---|
82 | begin
|
---|
83 | inherited;
|
---|
84 | Image := TImage32.Create(Parent);
|
---|
85 | Image.Parent := Parent;
|
---|
86 | Image.SetBounds(0, 0, Size.X, Size.Y);
|
---|
87 | Image.Bitmap.SetSize(Size.X, Size.Y);
|
---|
88 | Image.Show;
|
---|
89 | end;
|
---|
90 |
|
---|
91 | procedure TMethodGraphics32.Done;
|
---|
92 | begin
|
---|
93 | FreeAndNil(Image);
|
---|
94 | inherited Done;
|
---|
95 | end;
|
---|
96 |
|
---|
97 | {$ENDIF}
|
---|
98 |
|
---|
99 | end.
|
---|
100 |
|
---|