Subversion Repositories spacemission

Rev

Rev 1 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1 Rev 4
Line -... Line 1...
-
 
1
{*******************************************************}
-
 
2
{                                                       }
-
 
3
{       DIB and PAINTBOX componets                      }
-
 
4
{                                                       }
-
 
5
{       Copyright (C) 1997-2000 Hiroyuki Hori           }
-
 
6
{         base components and effects                   }
-
 
7
{       Copyright (C) 2000 Keith Murray                 }
-
 
8
{         supernova effect                              }
-
 
9
{       Copyright (C) 2000 Michel Hibon                 }
-
 
10
{         new special effects added for DIB             }
-
 
11
{       Copyright (C) 2001 Joakim Back                  }
-
 
12
{         conFusion effects (as DxFusion)               }
-
 
13
{       Copyright (C) 2003 Babak Sateli                 }
-
 
14
{         24-bit DIB effect as supplement ones          }
-
 
15
{       Copyright (C) 2004-2012 Jaro Benes              }
-
 
16
{         32-bit DIB effect with alphachannel           }
-
 
17
{         direct works with texture buffer              }
-
 
18
{         modified and adapted all adopted functions    }
-
 
19
{                                                       }
-
 
20
{*******************************************************}
-
 
21
 
1
unit DIB;
22
unit DIB;
2
 
23
 
3
interface
24
interface
4
 
25
 
5
{$INCLUDE DelphiXcfg.inc}
26
{$INCLUDE DelphiXcfg.inc}
-
 
27
{$DEFINE USE_SCANLINE}
6
 
28
 
7
uses
29
uses
8
  Windows, SysUtils, Classes, Graphics, Controls;
30
  Windows, SysUtils, Classes, Graphics, Controls,
-
 
31
  {$IFDEF VER17UP} Types, UITypes,{$ENDIF}
-
 
32
  Math;
9
 
33
 
10
type
34
type
-
 
35
  TColorLineStyle = (csSolid, csGradient, csRainbow);
-
 
36
  TColorLinePixelGeometry = (pgPoint, pgCircular, pgRectangular);
-
 
37
  PRGBQuads = ^TRGBQuads;
11
  TRGBQuads = array[0..255] of TRGBQuad;
38
  TRGBQuads = array[0..255] of TRGBQuad;
12
 
39
 
13
  TPaletteEntries = array[0..255] of TPaletteEntry;
40
  TPaletteEntries = array[0..255] of TPaletteEntry;
14
 
41
 
15
  PBGR = ^TBGR;
42
  PBGR = ^TBGR;
16
  TBGR = packed record
43
  TBGR = packed record
17
    B, G, R: Byte;
44
    B, G, R: Byte;
18
  end;
45
  end;
19
 
46
 
-
 
47
  {   Added this type for New SPecial Effect   }
-
 
48
  TFilter = array[0..2, 0..2] of SmallInt;
-
 
49
  TLines = array[0..0] of TBGR;
-
 
50
  PLines = ^TLines;
-
 
51
  TBytes = array[0..0] of Byte;
-
 
52
  PBytes = ^TBytes;
-
 
53
  TPBytes = array[0..0] of PBytes;
-
 
54
  PPBytes = ^TPBytes;
-
 
55
  {   End of type's   }
-
 
56
 
20
  PArrayBGR = ^TArrayBGR;
57
  PArrayBGR = ^TArrayBGR;
21
  TArrayBGR = array[0..10000] of TBGR;
58
  TArrayBGR = array[0..10000] of TBGR;
22
 
59
 
23
  PArrayByte = ^TArrayByte;
60
  PArrayByte = ^TArrayByte;
24
  TArrayByte = array[0..10000] of Byte;
61
  TArrayByte = array[0..10000] of Byte;
Line 27... Line 64...
27
  TArrayWord = array[0..10000] of Word;
64
  TArrayWord = array[0..10000] of Word;
28
 
65
 
29
  PArrayDWord = ^TArrayDWord;
66
  PArrayDWord = ^TArrayDWord;
30
  TArrayDWord = array[0..10000] of DWord;
67
  TArrayDWord = array[0..10000] of DWord;
31
 
68
 
32
  {  TDIB  }
69
  {  TDIBPixelFormat  }
33
 
70
 
34
  TDIBPixelFormat = record
71
  TDIBPixelFormat = record
35
    RBitMask, GBitMask, BBitMask: DWORD;
72
    RBitMask, GBitMask, BBitMask: DWORD;
36
    RBitCount, GBitCount, BBitCount: DWORD;
73
    RBitCount, GBitCount, BBitCount: DWORD;
37
    RShift, GShift, BShift: DWORD;
74
    RShift, GShift, BShift: DWORD;
38
    RBitCount2, GBitCount2, BBitCount2: DWORD;
75
    RBitCount2, GBitCount2, BBitCount2: DWORD;
39
  end;
76
  end;
40
 
77
 
-
 
78
  {  TDIBSharedImage  }
-
 
79
 
41
  TDIBSharedImage = class(TSharedImage)
80
  TDIBSharedImage = class(TSharedImage)
42
  private      
81
  private
43
    FBitCount: Integer;
82
    FBitCount: Integer;
44
    FBitmapInfo: PBitmapInfo;
83
    FBitmapInfo: PBitmapInfo;
45
    FBitmapInfoSize: Integer;
84
    FBitmapInfoSize: Integer;
Line 62... Line 101...
62
    FWidth: Integer;
101
    FWidth: Integer;
63
    FWidthBytes: Integer;
102
    FWidthBytes: Integer;
64
    constructor Create;
103
    constructor Create;
65
    procedure NewImage(AWidth, AHeight, ABitCount: Integer;
104
    procedure NewImage(AWidth, AHeight, ABitCount: Integer;
66
      const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean);
105
      const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean);
67
    procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean);
106
    procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); {$IFDEF VER9UP}inline;{$ENDIF}
68
    procedure Compress(Source: TDIBSharedImage);
107
    procedure Compress(Source: TDIBSharedImage);
69
    procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean);
108
    procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean);
70
    procedure ReadData(Stream: TStream; MemoryImage: Boolean);
109
    procedure ReadData(Stream: TStream; MemoryImage: Boolean);
71
    function GetPalette: THandle;
110
    function GetPalette: THandle;
72
    procedure SetColorTable(const Value: TRGBQuads);
111
    procedure SetColorTable(const Value: TRGBQuads);
Line 74... Line 113...
74
    procedure FreeHandle; override;
113
    procedure FreeHandle; override;
75
  public
114
  public
76
    destructor Destroy; override;
115
    destructor Destroy; override;
77
  end;
116
  end;
78
 
117
 
-
 
118
  {  TFilterTypeResample  }
-
 
119
 
-
 
120
  TFilterTypeResample = (ftrBox, ftrTriangle, ftrHermite, ftrBell, ftrBSpline,
-
 
121
    ftrLanczos3, ftrMitchell);
-
 
122
 
-
 
123
  TDistortType = (dtFast, dtSlow);
-
 
124
  {DXFusion effect type}
-
 
125
  TFilterMode = (fmNormal, fmMix50, fmMix25, fmMix75);
-
 
126
 
-
 
127
  {  TLightSource  }
-
 
128
 
-
 
129
  TLightSource = record
-
 
130
    X, Y: Integer;
-
 
131
    Size1, Size2: Integer;
-
 
132
    Color: TColor;
-
 
133
  end;
-
 
134
 
-
 
135
  {  TLightArray  }
-
 
136
 
-
 
137
  TLightArray = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TLightsource;
-
 
138
 
-
 
139
  {  TMatrixSetting  }
-
 
140
 
-
 
141
  TMatrixSetting = array[0..9] of Integer;
-
 
142
 
-
 
143
  {  TDIB  }
-
 
144
 
79
  TDIB = class(TGraphic)
145
  TDIB = class(TGraphic)
80
  private
146
  private
81
    FCanvas: TCanvas;
147
    FCanvas: TCanvas;
82
    FImage: TDIBSharedImage;    
148
    FImage: TDIBSharedImage;
83
 
149
 
Line 94... Line 160...
94
    FPBits: Pointer;
160
    FPBits: Pointer;
95
    FSize: Integer;
161
    FSize: Integer;
96
    FTopPBits: Pointer;
162
    FTopPBits: Pointer;
97
    FWidth: Integer;
163
    FWidth: Integer;
98
    FWidthBytes: Integer;
164
    FWidthBytes: Integer;
-
 
165
    FLUTDist: array[0..255, 0..255] of Integer;
-
 
166
    LG_COUNT: Integer;
-
 
167
    LG_DETAIL: Integer;
-
 
168
    FFreeList: TList;
99
    procedure AllocHandle;
169
    procedure AllocHandle;
100
    procedure CanvasChanging(Sender: TObject);
170
    procedure CanvasChanging(Sender: TObject);
101
    procedure Changing(MemoryImage: Boolean);
171
    procedure Changing(MemoryImage: Boolean);
102
    procedure ConvertBitCount(ABitCount: Integer);
172
    procedure ConvertBitCount(ABitCount: Integer);
103
    function GetBitmapInfo: PBitmapInfo;
173
    function GetBitmapInfo: PBitmapInfo;
Line 111... Line 181...
111
    function GetScanLine(Y: Integer): Pointer;
181
    function GetScanLine(Y: Integer): Pointer;
112
    function GetScanLineReadOnly(Y: Integer): Pointer;
182
    function GetScanLineReadOnly(Y: Integer): Pointer;
113
    function GetTopPBits: Pointer;
183
    function GetTopPBits: Pointer;
114
    function GetTopPBitsReadOnly: Pointer;
184
    function GetTopPBitsReadOnly: Pointer;
115
    procedure SetBitCount(Value: Integer);
185
    procedure SetBitCount(Value: Integer);
116
    procedure SetImage(Value: TDIBSharedImage);
186
    procedure SetImage(Value: TDIBSharedImage); {$IFDEF VER9UP}inline;{$ENDIF}
117
    procedure SetNowPixelFormat(const Value: TDIBPixelFormat);
187
    procedure SetNowPixelFormat(const Value: TDIBPixelFormat);
118
    procedure SetPixel(X, Y: Integer; Value: DWORD);
188
    procedure SetPixel(X, Y: Integer; Value: DWORD);
119
    procedure StartProgress(const Name: string);
189
    procedure StartProgress(const Name: string);
120
    procedure EndProgress;
190
    procedure EndProgress;
121
    procedure UpdateProgress(PercentY: Integer);
191
    procedure UpdateProgress(PercentY: Integer);
-
 
192
 
-
 
193
    {   Added these 3 functions for New Specials Effects   }
-
 
194
    function Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
-
 
195
    function IntToByte(i: Integer): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
-
 
196
    function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
-
 
197
    {   End of 3 functions for New Special Effect   }
-
 
198
 
-
 
199
    procedure Darkness(Amount: Integer);
-
 
200
    function GetAlphaChannel: TDIB;
-
 
201
    procedure SetAlphaChannel(const Value: TDIB);
-
 
202
    function GetClientRect: TRect;
-
 
203
    function GetRGBChannel: TDIB;
-
 
204
    procedure SetRGBChannel(const Value: TDIB);
122
  protected
205
  protected
123
    procedure DefineProperties(Filer: TFiler); override;
206
    procedure DefineProperties(Filer: TFiler); override;
124
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
207
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
125
    function GetEmpty: Boolean; override;
208
    function GetEmpty: Boolean; override;
126
    function GetHeight: Integer; override;
209
    function GetHeight: Integer; override;
127
    function GetPalette: HPalette; override;
210
    function GetPalette: HPalette; override;
128
    function GetWidth: Integer; override;
211
    function GetWidth: Integer; override;
129
    procedure ReadData(Stream: TStream); override;
212
    procedure ReadData(Stream: TStream); override;
Line 139... Line 222...
139
    procedure Assign(Source: TPersistent); override;
222
    procedure Assign(Source: TPersistent); override;
140
    procedure Clear;
223
    procedure Clear;
141
    procedure Compress;
224
    procedure Compress;
142
    procedure Decompress;
225
    procedure Decompress;
143
    procedure FreeHandle;
226
    procedure FreeHandle;
-
 
227
    function HasAlphaChannel: Boolean;
-
 
228
    function AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
-
 
229
    procedure RetAlphaChannel(out oDIB: TDIB);
144
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
230
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
145
      APalette: HPALETTE); override;
231
      APalette: HPALETTE); override;
146
    procedure LoadFromStream(Stream: TStream); override;
232
    procedure LoadFromStream(Stream: TStream); override;
147
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
233
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
148
      var APalette: HPALETTE); override;
234
      var APalette: HPALETTE); override;
149
    procedure SaveToStream(Stream: TStream); override;
235
    procedure SaveToStream(Stream: TStream); override;
150
    procedure SetSize(AWidth, AHeight, ABitCount: Integer);
236
    procedure SetSize(AWidth, AHeight, ABitCount: Integer); {$IFDEF VER5UP}reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF}
151
    procedure UpdatePalette;
237
    procedure UpdatePalette;
152
    {  Special effect  }
238
    {  Special effect  }
153
    procedure Blur(ABitCount: Integer; Radius: Integer);
239
    procedure Blur(ABitCount: Integer; Radius: Integer);
154
    procedure Greyscale(ABitCount: Integer);
240
    procedure Greyscale(ABitCount: Integer);
155
    procedure Mirror(MirrorX, MirrorY: Boolean);
241
    procedure Mirror(MirrorX, MirrorY: Boolean);
156
    procedure Negative;
242
    procedure Negative;
157
 
243
 
-
 
244
    {   Added New Special Effect   }
-
 
245
    procedure Spray(Amount: Integer);
-
 
246
    procedure Emboss;
-
 
247
    procedure AddMonoNoise(Amount: Integer);
-
 
248
    procedure AddGradiantNoise(Amount: byte);
-
 
249
    function Twist(bmp: TDIB; Amount: byte): Boolean;
-
 
250
    function FishEye(bmp: TDIB): Boolean;
-
 
251
    function SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean;
-
 
252
    procedure Lightness(Amount: Integer);
-
 
253
    procedure Saturation(Amount: Integer);
-
 
254
    procedure Contrast(Amount: Integer);
-
 
255
    procedure AddRGB(aR, aG, aB: Byte);
-
 
256
    function Filter(Dest: TDIB; Filter: TFilter): Boolean;
-
 
257
    procedure Sharpen(Amount: Integer);
-
 
258
    function IntToColor(i: Integer): TBGR; {$IFDEF VER9UP}inline;{$ENDIF}
-
 
259
    function Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean;
-
 
260
    procedure SplitBlur(Amount: Integer);
-
 
261
    procedure GaussianBlur(Bmp: TDIB; Amount: Integer);
-
 
262
    {   End of New Special Effect   }
-
 
263
    {
-
 
264
    New effect for TDIB
-
 
265
    with Some Effects like AntiAlias, Contrast,
-
 
266
    Lightness, Saturation, GaussianBlur, Mosaic,
-
 
267
    Twist, Splitlight, Trace, Emboss, etc.
-
 
268
    Works with 24bit color DIBs.
-
 
269
 
-
 
270
    This component is based on TProEffectImage component version 1.0 by
-
 
271
    Written By Babak Sateli (babak_sateli@yahoo.com, http://raveland.netfirms.com)
-
 
272
 
-
 
273
    and modified by (c) 2004 Jaro Benes
-
 
274
    for DelphiX use.
-
 
275
 
-
 
276
    Demo was modified into DXForm with function like  original
-
 
277
 
-
 
278
    DISCLAIMER
-
 
279
    This component is provided AS-IS without any warranty of any kind, either express or
-
 
280
    implied. This component is freeware and can be used in any software product.
-
 
281
    }
-
 
282
    procedure DoInvert;
-
 
283
    procedure DoAddColorNoise(Amount: Integer);
-
 
284
    procedure DoAddMonoNoise(Amount: Integer);
-
 
285
    procedure DoAntiAlias;
-
 
286
    procedure DoContrast(Amount: Integer);
-
 
287
    procedure DoFishEye(Amount: Integer);
-
 
288
    procedure DoGrayScale;
-
 
289
    procedure DoLightness(Amount: Integer);
-
 
290
    procedure DoDarkness(Amount: Integer);
-
 
291
    procedure DoSaturation(Amount: Integer);
-
 
292
    procedure DoSplitBlur(Amount: Integer);
-
 
293
    procedure DoGaussianBlur(Amount: Integer);
-
 
294
    procedure DoMosaic(Size: Integer);
-
 
295
    procedure DoTwist(Amount: Integer);
-
 
296
    procedure DoSplitlight(Amount: Integer);
-
 
297
    procedure DoTile(Amount: Integer);
-
 
298
    procedure DoSpotLight(Amount: Integer; Spot: TRect);
-
 
299
    procedure DoTrace(Amount: Integer);
-
 
300
    procedure DoEmboss;
-
 
301
    procedure DoSolorize(Amount: Integer);
-
 
302
    procedure DoPosterize(Amount: Integer);
-
 
303
    procedure DoBrightness(Amount: Integer);
-
 
304
    procedure DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample);
-
 
305
    {rotate}
-
 
306
    procedure DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended);
-
 
307
    procedure DoColorize(ForeColor, BackColor: TColor);
-
 
308
    {Simple explosion spoke effect}
-
 
309
    procedure DoNovaEffect(sr, sg, sb, cx, cy, radius,
-
 
310
      nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent);
-
 
311
 
-
 
312
    {Simple Mandelbrot-set drawing}
-
 
313
    procedure DrawMandelbrot(ao, au: Integer; bo, bu: Double);
-
 
314
 
-
 
315
    {Sephia effect}
-
 
316
    procedure SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF});
-
 
317
 
-
 
318
    {Simple blend pixel}
-
 
319
    procedure BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
-
 
320
    {Line in polar system}
-
 
321
    procedure LinePolar(x, y: Integer; AngleInDegree, Length: extended;
-
 
322
      Color: cardinal);
-
 
323
 
-
 
324
    {special version Dark/Light procedure in percent}
-
 
325
    procedure Darker(Percent: Integer);
-
 
326
    procedure Lighter(Percent: Integer);
-
 
327
 
-
 
328
    {Simple graphical crypt}
-
 
329
    procedure EncryptDecrypt(const Key: Integer);
-
 
330
 
-
 
331
    { Standalone DXFusion }
-
 
332
    {--- c o n F u s i o n ---}
-
 
333
    {By Joakim Back, www.back.mine.nu}
-
 
334
    {Huge thanks to Ilkka Tuomioja for helping out with the project.}
-
 
335
 
-
 
336
    {
-
 
337
    modified by (c) 2005 Jaro Benes for DelphiX use.
-
 
338
    }
-
 
339
 
-
 
340
    procedure CreateDIBFromBitmap(const Bitmap: TBitmap);
-
 
341
    {Drawing Methods.}
-
 
342
    procedure DrawOn(Dest: TRect; DestCanvas: TCanvas;
-
 
343
      Xsrc, Ysrc: Integer);
-
 
344
    procedure DrawTo(SrcDIB: TDIB; X, Y, Width, Height, SourceX,
-
 
345
      SourceY: Integer);
-
 
346
    procedure DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height,
-
 
347
      SourceX, SourceY: Integer; const Color: TColor); {$IFDEF VER5UP} reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF}
-
 
348
    procedure DrawShadow(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;
-
 
349
      FilterMode: TFilterMode);
-
 
350
    procedure DrawShadows(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;
-
 
351
      Alpha: Byte);
-
 
352
    procedure DrawDarken(SrcDIB: TDIB; X, Y, Width, Height,
-
 
353
      Frame: Integer);
-
 
354
    procedure DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF};
-
 
355
      Frame: Integer{$IFDEF VER4UP} = 0{$ENDIF});
-
 
356
    procedure DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
-
 
357
      SourceX, SourceY: Integer; const Color: TColor;
-
 
358
      FilterMode: TFilterMode);
-
 
359
    procedure DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height,
-
 
360
      SourceX, SourceY: Integer; const Color: TColor);
-
 
361
    procedure DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
-
 
362
      SourceY: Integer; const Color: TColor);
-
 
363
    procedure DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
-
 
364
      SourceY, Alpha: Integer; const Color: TColor);
-
 
365
    procedure DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y, Width,
-
 
366
      Height, SourceX, SourceY: Integer);
-
 
367
    procedure DrawAntialias(SrcDIB: TDIB);
-
 
368
    procedure Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting);
-
 
369
    procedure DrawMono(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
-
 
370
      SourceY: Integer; const TransColor, ForeColor, BackColor: TColor);
-
 
371
    {One-color Filters.}
-
 
372
    procedure FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor;
-
 
373
      FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}
-
 
374
    procedure FilterRect(X, Y, Width, Height: Integer; Color: TColor;
-
 
375
      FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}
-
 
376
    { Lightsource. }
-
 
377
    procedure InitLight(Count, Detail: Integer);
-
 
378
    procedure DrawLights(FLight: TLightArray; AmbientLight: TColor);
-
 
379
    //
-
 
380
    // effect for special purpose
-
 
381
    //
-
 
382
    procedure FadeOut(DIB2: TDIB; Step: Byte);
-
 
383
    procedure DoZoom(DIB2: TDIB; ZoomRatio: Real);
-
 
384
    procedure DoBlur(DIB2: TDIB);
-
 
385
    procedure FadeIn(DIB2: TDIB; Step: Byte);
-
 
386
    procedure FillDIB8(Color: Byte);
-
 
387
    procedure DoRotate(DIB1: TDIB; cX, cY, Angle: Integer);
-
 
388
    procedure Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real);
-
 
389
    function Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean;
-
 
390
    // lines
-
 
391
    procedure AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor); {$IFDEF VER9UP} inline; {$ENDIF}
-
 
392
    function GetColorBetween(StartColor, EndColor: TColor; Pointvalue,
-
 
393
      FromPoint, ToPoint: Extended): TColor;
-
 
394
    procedure ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle;
-
 
395
      iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry;
-
 
396
      iRadius: WORD);
-
 
397
    // standard property
158
    property BitCount: Integer read FBitCount write SetBitCount;
398
    property BitCount: Integer read FBitCount write SetBitCount;
159
    property BitmapInfo: PBitmapInfo read GetBitmapInfo;
399
    property BitmapInfo: PBitmapInfo read GetBitmapInfo;
160
    property BitmapInfoSize: Integer read GetBitmapInfoSize;
400
    property BitmapInfoSize: Integer read GetBitmapInfoSize;
161
    property Canvas: TCanvas read GetCanvas;
401
    property Canvas: TCanvas read GetCanvas;
162
    property Handle: THandle read GetHandle;
402
    property Handle: THandle read GetHandle;
Line 172... Line 412...
172
    property Size: Integer read FSize;
412
    property Size: Integer read FSize;
173
    property TopPBits: Pointer read GetTopPBits;
413
    property TopPBits: Pointer read GetTopPBits;
174
    property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly;
414
    property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly;
175
    property Width: Integer read FWidth write SetWidth;
415
    property Width: Integer read FWidth write SetWidth;
176
    property WidthBytes: Integer read FWidthBytes;
416
    property WidthBytes: Integer read FWidthBytes;
-
 
417
    property AlphaChannel: TDIB read GetAlphaChannel write SetAlphaChannel;
-
 
418
    property RGBChannel: TDIB read GetRGBChannel write SetRGBChannel;
-
 
419
    function CreateBitmapFromDIB: TBitmap;
-
 
420
    procedure Fill(aColor: TColor);
-
 
421
    property ClientRect: TRect read GetClientRect;
177
  end;
422
  end;
178
 
423
 
-
 
424
  {  TDIBitmap  }
-
 
425
 
179
  TDIBitmap = class(TDIB) end;
426
  TDIBitmap = class(TDIB) end;
180
 
427
 
181
  {  TCustomDXDIB  }
428
  {  TCustomDXDIB  }
182
 
429
 
183
  TCustomDXDIB = class(TComponent)
430
  TCustomDXDIB = class(TComponent)
Line 233... Line 480...
233
 
480
 
234
  {  TDXPaintBox  }
481
  {  TDXPaintBox  }
235
 
482
 
236
  TDXPaintBox = class(TCustomDXPaintBox)
483
  TDXPaintBox = class(TCustomDXPaintBox)
237
  published
484
  published
238
    {$IFDEF DelphiX_Spt4}property Anchors;{$ENDIF}
485
{$IFDEF VER4UP}property Anchors; {$ENDIF}
239
    property AutoStretch;
486
    property AutoStretch;
240
    property Center;
487
    property Center;
241
    {$IFDEF DelphiX_Spt4}property Constraints;{$ENDIF}
488
{$IFDEF VER4UP}property Constraints; {$ENDIF}
242
    property DIB;
489
    property DIB;
243
    property KeepAspect;
490
    property KeepAspect;
244
    property Stretch;
491
    property Stretch;
245
    property ViewWidth;
492
    property ViewWidth;
246
    property ViewHeight;
493
    property ViewHeight;
Line 259... Line 506...
259
    property OnDragOver;
506
    property OnDragOver;
260
    property OnEndDrag;
507
    property OnEndDrag;
261
    property OnMouseDown;
508
    property OnMouseDown;
262
    property OnMouseMove;
509
    property OnMouseMove;
263
    property OnMouseUp;
510
    property OnMouseUp;
-
 
511
{$IFDEF VER9UP}property OnMouseWheel; {$ENDIF}
-
 
512
{$IFDEF VER9UP}property OnResize; {$ENDIF}
-
 
513
{$IFDEF VER9UP}property OnCanResize; {$ENDIF}
-
 
514
{$IFDEF VER9UP}property OnContextPopup; {$ENDIF}
264
    property OnStartDrag;
515
    property OnStartDrag;
265
  end;
516
  end;
266
 
517
 
-
 
518
const
-
 
519
  DefaultFilterRadius: array[TFilterTypeResample] of Single = (0.5, 1, 1, 1.5, 2, 3, 2);
-
 
520
 
267
function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat;
521
function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF}
268
function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat;
522
function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF}
269
function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD;
523
function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; {$IFDEF VER9UP}inline;{$ENDIF}
270
procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte);
524
procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
271
function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
525
function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
272
function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
526
function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
273
function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
527
function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
274
 
528
 
275
function GreyscaleColorTable: TRGBQuads;
529
function GreyscaleColorTable: TRGBQuads;
276
 
530
 
277
function RGBQuad(R, G, B: Byte): TRGBQuad;
531
function RGBQuad(R, G, B: Byte): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF}
278
function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad;
532
function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF}
279
function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads;
533
function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; {$IFDEF VER9UP}inline;{$ENDIF}
280
function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry;
534
function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; {$IFDEF VER9UP}inline;{$ENDIF}
281
function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries;
535
function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; {$IFDEF VER9UP}inline;{$ENDIF}
-
 
536
 
-
 
537
function PosValue(Value: Integer): Integer;
-
 
538
 
-
 
539
type
-
 
540
  TOC = 0..511;
-
 
541
function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
-
 
542
function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
-
 
543
 
-
 
544
{   Added Constants for TFilter Type   }
-
 
545
const
-
 
546
  EdgeFilter: TFilter = ((-1, -1, -1), (-1, 8, -1), (-1, -1, -1));
-
 
547
  StrongOutlineFilter: TFilter = ((-100, 0, 0), (0, 0, 0), (0, 0, 100));
-
 
548
  Enhance3DFilter: TFilter = ((-100, 5, 5), (5, 5, 5), (5, 5, 100));
-
 
549
  LinearFilter: TFilter = ((-40, -40, -40), (-40, 255, -40), (-40, -40, -40));
-
 
550
  GranularFilter: TFilter = ((-20, 5, 20), (5, -10, 5), (100, 5, -100));
-
 
551
  SharpFilter: TFilter = ((-2, -2, -2), (-2, 20, -2), (-2, -2, -2));
-
 
552
{   End of constants   }
-
 
553
 
-
 
554
{   Added Constants for DXFusion Type   }
-
 
555
const
-
 
556
  { 3x3 Matrix Presets. }
-
 
557
  msEmboss: TMatrixSetting = (-1, -1, 0, -1, 6, 1, 0, 1, 1, 6);
-
 
558
  msHardEmboss: TMatrixSetting = (-4, -2, -1, -2, 10, 2, -1, 2, 4, 8);
-
 
559
  msBlur: TMatrixSetting = (1, 2, 1, 2, 4, 2, 1, 2, 1, 16);
-
 
560
  msSharpen: TMatrixSetting = (-1, -1, -1, -1, 15, -1, -1, -1, -1, 7);
-
 
561
  msEdgeDetect: TMatrixSetting = (-1, -1, -1, -1, 8, -1, -1, -1, -1, 1);
-
 
562
 
-
 
563
{Proportionaly scale of size, for recountin image sizes}
-
 
564
function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single; {$IFDEF VER9UP}inline;{$ENDIF}
-
 
565
 
-
 
566
procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP}overload; {$ENDIF}
-
 
567
procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDIB2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP}overload; {$ENDIF}
282
 
568
 
283
implementation
569
implementation
284
 
570
 
-
 
571
uses DXConsts, {$IFDEF PNG_GRAPHICS}pngimage,{$ENDIF} jpeg;
-
 
572
 
-
 
573
function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single;
-
 
574
var
-
 
575
  XScale, YScale: Single;
-
 
576
begin
-
 
577
  XScale := 1;
-
 
578
  YScale := 1;
-
 
579
  if TargetWidth < SourceWidth then
-
 
580
    XScale := TargetWidth / SourceWidth;
-
 
581
  if TargetHeight < SourceHeight then
-
 
582
    YScale := TargetHeight / SourceHeight;
285
uses DXConsts;
583
  Result := XScale;
-
 
584
  if YScale < Result then
-
 
585
    Result := YScale;
-
 
586
end;
286
 
587
 
-
 
588
{$IFNDEF VER4UP}
287
function Max(B1, B2: Integer): Integer;
589
function Max(B1, B2: Integer): Integer;
288
begin
590
begin
289
  if B1>=B2 then Result := B1 else Result := B2;
591
  if B1 >= B2 then Result := B1 else Result := B2;
290
end;
592
end;
291
 
593
 
-
 
594
function Min(B1, B2: Integer): Integer;
-
 
595
begin
-
 
596
  if B1 <= B2 then Result := B1 else Result := B2;
-
 
597
end;
-
 
598
{$ENDIF}
-
 
599
 
-
 
600
function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
-
 
601
begin
-
 
602
  Result := sin(((c * 360) / 511) * Pi / 180);
-
 
603
end;
-
 
604
 
-
 
605
function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
-
 
606
begin
-
 
607
  Result := cos(((c * 360) / 511) * Pi / 180);
-
 
608
end;
-
 
609
 
292
function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat;
610
function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat;
293
begin
611
begin
294
  Result.RBitMask := ((1 shl RBitCount)-1) shl (GBitCount+BBitCount);
612
  Result.RBitMask := ((1 shl RBitCount) - 1) shl (GBitCount + BBitCount);
295
  Result.GBitMask := ((1 shl GBitCount)-1) shl (BBitCount);
613
  Result.GBitMask := ((1 shl GBitCount) - 1) shl (BBitCount);
296
  Result.BBitMask := (1 shl BBitCount)-1;
614
  Result.BBitMask := (1 shl BBitCount) - 1;
Line 303... Line 621...
303
  Result.RShift := (GBitCount+BBitCount)-(8-RBitCount);
621
  Result.RShift := (GBitCount + BBitCount) - (8 - RBitCount);
304
  Result.GShift := BBitCount-(8-GBitCount);
622
  Result.GShift := BBitCount - (8 - GBitCount);
305
  Result.BShift := 8-BBitCount;
623
  Result.BShift := 8 - BBitCount;
306
end;
624
end;
307
 
625
 
308
function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat;
-
 
309
 
-
 
310
  function GetBitCount(b: Integer): Integer;
626
function GetBitCount(b: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
311
  var
627
var
312
    i: Integer;
628
  i: Integer;
313
  begin
629
begin
314
    i := 0;
630
  i := 0;
315
    while (i<31) and (((1 shl i) and b)=0) do Inc(i);
631
  while (i < 31) and (((1 shl i) and b) = 0) do Inc(i);
Line 320... Line 636...
320
      Inc(i);
636
    Inc(i);
321
      Inc(Result);
637
    Inc(Result);
322
    end;
638
  end;
323
  end;
639
end;
324
 
640
 
-
 
641
function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat;
325
begin
642
begin
326
  Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask),
643
  Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask),
327
    GetBitCount(BBitMask));
644
    GetBitCount(BBitMask));
328
end;
645
end;
329
 
646
 
Line 350... Line 667...
350
function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
667
function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
351
begin
668
begin
352
  with PixelFormat do
669
  with PixelFormat do
353
  begin
670
  begin
354
    Result := (Color and RBitMask) shr RShift;
671
    Result := (Color and RBitMask) shr RShift;
355
    Result := Result or (Result shr RBitCount);
672
    Result := Result or (Result shr RBitCount2);
356
  end;
673
  end;
357
end;
674
end;
358
 
675
 
359
function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
676
function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
360
begin
677
begin
361
  with PixelFormat do
678
  with PixelFormat do
362
  begin
679
  begin
363
    Result := (Color and GBitMask) shr GShift;
680
    Result := (Color and GBitMask) shr GShift;
364
    Result := Result or (Result shr GBitCount);
681
    Result := Result or (Result shr GBitCount2);
365
  end;
682
  end;
366
end;
683
end;
367
 
684
 
368
function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
685
function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
369
begin
686
begin
370
  with PixelFormat do
687
  with PixelFormat do
371
  begin
688
  begin
372
    Result := (Color and BBitMask) shl BShift;
689
    Result := (Color and BBitMask) shl BShift;
373
    Result := Result or (Result shr BBitCount);
690
    Result := Result or (Result shr BBitCount2);
374
  end;
691
  end;
375
end;
692
end;
376
 
693
 
377
function GreyscaleColorTable: TRGBQuads;
694
function GreyscaleColorTable: TRGBQuads;
378
var
695
var
Line 445... Line 762...
445
  PLocalDIBPixelFormat = ^TLocalDIBPixelFormat;
762
  PLocalDIBPixelFormat = ^TLocalDIBPixelFormat;
446
  TLocalDIBPixelFormat = packed record
763
  TLocalDIBPixelFormat = packed record
447
    RBitMask, GBitMask, BBitMask: DWORD;
764
    RBitMask, GBitMask, BBitMask: DWORD;
448
  end;
765
  end;
449
 
766
 
-
 
767
  {  TPaletteItem  }
-
 
768
 
450
  TPaletteItem = class(TCollectionItem)
769
  TPaletteItem = class(TCollectionItem)
451
  private
770
  private
452
    ID: Integer;
771
    ID: Integer;
453
    Palette: HPalette;
772
    Palette: HPalette;
454
    RefCount: Integer;
773
    RefCount: Integer;
455
    ColorTable: TRGBQuads;
774
    ColorTable: TRGBQuads;
456
    ColorTableCount: Integer;
775
    ColorTableCount: Integer;
457
    destructor Destroy; override;
776
    destructor Destroy; override;
458
    procedure AddRef;
777
    procedure AddRef;
459
    procedure Release;
778
    procedure Release; {$IFDEF VER17UP}reintroduce;{$ENDIF}
460
  end;
779
  end;
461
 
780
 
-
 
781
  {  TPaletteManager  }
-
 
782
 
462
  TPaletteManager = class
783
  TPaletteManager = class
463
  private
784
  private
464
    FList: TCollection;
785
    FList: TCollection;
465
    constructor Create;
786
    constructor Create;
466
    destructor Destroy; override;
787
    destructor Destroy; override;
467
    function CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette;
788
    function CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette;
468
    procedure DeletePalette(var Palette: HPalette);
789
    procedure DeletePalette(var Palette: HPalette);
469
  end;
790
  end;
470
 
791
 
-
 
792
{  TPaletteItem  }
-
 
793
 
471
destructor TPaletteItem.Destroy;
794
destructor TPaletteItem.Destroy;
472
begin
795
begin
473
  DeleteObject(Palette);
796
  DeleteObject(Palette);
474
  inherited Destroy;
797
  inherited Destroy;
475
end;
798
end;
Line 483... Line 806...
483
begin
806
begin
484
  Dec(RefCount);
807
  Dec(RefCount);
485
  if RefCount<=0 then Free;
808
  if RefCount <= 0 then Free;
486
end;
809
end;
487
 
810
 
-
 
811
{  TPaletteManager  }
-
 
812
 
488
constructor TPaletteManager.Create;
813
constructor TPaletteManager.Create;
489
begin
814
begin
490
  inherited Create;
815
  inherited Create;
491
  FList := TCollection.Create(TPaletteItem);
816
  FList := TCollection.Create(TPaletteItem);
492
end;
817
end;
Line 575... Line 900...
575
  if FPaletteManager=nil then
900
  if FPaletteManager = nil then
576
    FPaletteManager := TPaletteManager.Create;
901
    FPaletteManager := TPaletteManager.Create;
577
  Result := FPaletteManager;
902
  Result := FPaletteManager;
578
end;
903
end;
579
 
904
 
-
 
905
{  TDIBSharedImage  }
-
 
906
 
580
constructor TDIBSharedImage.Create;
907
constructor TDIBSharedImage.Create;
581
begin
908
begin
582
  inherited Create;
909
  inherited Create;
583
  FMemoryImage := True;
910
  FMemoryImage := True;
584
  SetColorTable(GreyscaleColorTable);
911
  SetColorTable(GreyscaleColorTable);
Line 590... Line 917...
590
  const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean);
917
  const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean);
591
var
918
var
592
  InfoOfs: Integer;
919
  InfoOfs: Integer;
593
  UsePixelFormat: Boolean;
920
  UsePixelFormat: Boolean;
594
begin
921
begin
-
 
922
  {$IFNDEF D17UP}
-
 
923
  {self recreation is not allowed here}
595
  Create;
924
  Create;
596
 
925
  {$ENDIF}
597
  {  Pixel format check  }
926
  {  Pixel format check  }
598
  case ABitCount of
927
  case ABitCount of
599
    1 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then
928
    1: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
600
            raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
929
        raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
601
    4 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then
930
    4: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
602
            raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
931
        raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
603
    8 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then
932
    8: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
604
            raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
933
        raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
-
 
934
    16:
605
    16: begin
935
      begin
606
          if not (((PixelFormat.RBitMask=$7C00) and (PixelFormat.GBitMask=$03E0) and (PixelFormat.BBitMask=$001F)) or
936
        if not (((PixelFormat.RBitMask = $7C00) and (PixelFormat.GBitMask = $03E0) and (PixelFormat.BBitMask = $001F)) or
607
            ((PixelFormat.RBitMask=$F800) and (PixelFormat.GBitMask=$07E0) and (PixelFormat.BBitMask=$001F))) then
937
          ((PixelFormat.RBitMask = $F800) and (PixelFormat.GBitMask = $07E0) and (PixelFormat.BBitMask = $001F))) then
608
            raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
938
          raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
609
        end;
939
      end;
-
 
940
    24:
610
    24: begin
941
      begin
611
          if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then
942
        if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
612
            raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
943
          raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
613
        end;
944
      end;
-
 
945
    32:
614
    32: begin
946
      begin
615
          if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then
947
        if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
616
            raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
948
          raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
617
        end;
949
      end;
618
  else
950
  else
619
    raise EInvalidGraphicOperation.CreateFmt(SInvalidDIBBitCount, [ABitCount]);
951
    raise EInvalidGraphicOperation.CreateFmt(SInvalidDIBBitCount, [ABitCount]);
Line 694... Line 1026...
694
    if MemoryImage then
1026
    if MemoryImage then
695
    begin
1027
    begin
696
      FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize));
1028
      FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize));
697
      if FPBits=nil then
1029
      if FPBits = nil then
698
        OutOfMemoryError;
1030
        OutOfMemoryError;
-
 
1031
    end
699
    end else
1032
    else
700
    begin
1033
    begin
701
      FDC := CreateCompatibleDC(0);
1034
      FDC := CreateCompatibleDC(0);
702
 
1035
 
703
      FHandle := CreateDIBSection(FDC, FBitmapInfo^, DIB_RGB_COLORS, FPBits, 0, 0);
1036
      FHandle := CreateDIBSection(FDC, FBitmapInfo^, DIB_RGB_COLORS, FPBits, 0, 0);
704
      if FHandle=0 then
1037
      if FHandle = 0 then
Line 711... Line 1044...
711
  FTopPBits := Pointer(Integer(FPBits)+(FHeight-1)*FWidthBytes);
1044
  FTopPBits := Pointer(Integer(FPBits) + (FHeight - 1) * FWidthBytes);
712
end;
1045
end;
713
 
1046
 
714
procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean);
1047
procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean);
715
begin
1048
begin
-
 
1049
  if Source = nil then Exit; //no source
-
 
1050
 
716
  if Source.FSize=0 then
1051
  if Source.FSize = 0 then
717
  begin
1052
  begin
-
 
1053
    {$IFNDEF D17UP}
-
 
1054
    {self recreation is not allowed here}
718
    Create;
1055
    Create;
-
 
1056
    {$ENDIF}
719
    FMemoryImage := MemoryImage;
1057
    FMemoryImage := MemoryImage;
-
 
1058
  end
720
  end else
1059
  else
721
  begin
1060
  begin
722
    NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
1061
    NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
723
      Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed);
1062
      Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed);
724
    if FCompressed then
1063
    if FCompressed then
725
    begin
1064
    begin
726
      FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage;
1065
      FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage;
727
      GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage);
1066
      GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage);
728
      Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
1067
      Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
-
 
1068
    end
729
    end else
1069
    else
730
    begin
1070
    begin
731
      Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
1071
      Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
732
    end;
1072
    end;
733
  end;
1073
  end;
734
end;
1074
end;
Line 787... Line 1127...
787
            C := (C shr 4) or (C shl 4);
1127
            C := (C shr 4) or (C shl 4);
788
          end;
1128
          end;
789
 
1129
 
790
          AllocByte^ := B1;
1130
          AllocByte^ := B1;
791
          AllocByte^ := B2;
1131
          AllocByte^ := B2;
-
 
1132
        end
792
        end else
1133
        else
793
        if (Source.FWidth-x>5) and ((GetPixel(x)<>GetPixel(x+2)) or (GetPixel(x+1)<>GetPixel(x+3))) and
1134
          if (Source.FWidth - x > 5) and ((GetPixel(x) <> GetPixel(x + 2)) or (GetPixel(x + 1) <> GetPixel(x + 3))) and
794
          ((GetPixel(x+2)=GetPixel(x+4)) and (GetPixel(x+3)=GetPixel(x+5))) then
1135
            ((GetPixel(x + 2) = GetPixel(x + 4)) and (GetPixel(x + 3) = GetPixel(x + 5))) then
795
        begin
1136
          begin
796
          {  Encoding mode }
1137
          {  Encoding mode }
797
          AllocByte^ := 2;
1138
            AllocByte^ := 2;
798
          AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1);
1139
            AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1);
799
          Inc(x, 2);
1140
            Inc(x, 2);
-
 
1141
          end
800
        end else
1142
          else
801
        begin
1143
          begin
802
          if (Source.FWidth-x<4) then
1144
            if (Source.FWidth - x < 4) then
803
          begin
1145
            begin
804
            {  Encoding mode }
1146
            {  Encoding mode }
805
            while Source.FWidth-x>=2 do
1147
              while Source.FWidth - x >= 2 do
Line 813... Line 1155...
813
            begin
1155
              begin
814
              AllocByte^ := 1;
1156
                AllocByte^ := 1;
815
              AllocByte^ := GetPixel(x) shl 4;
1157
                AllocByte^ := GetPixel(x) shl 4;
816
              Inc(x);
1158
                Inc(x);
817
            end;
1159
              end;
-
 
1160
            end
818
          end else
1161
            else
819
          begin
1162
            begin
820
            {  Absolute mode  }
1163
            {  Absolute mode  }
821
            PB1 := Size; AllocByte;
1164
              PB1 := Size; AllocByte;
822
            PB2 := Size; AllocByte;
1165
              PB2 := Size; AllocByte;
823
 
1166
 
Line 902... Line 1245...
902
            Inc(Src);
1245
            Inc(Src);
903
          end;
1246
          end;
904
 
1247
 
905
          AllocByte^ := B1;
1248
          AllocByte^ := B1;
906
          AllocByte^ := B2;
1249
          AllocByte^ := B2;
-
 
1250
        end
907
        end else
1251
        else
908
        if (Source.FWidth-x>2) and (Src^<>PByte(Integer(Src)+1)^) and (PByte(Integer(Src)+1)^=PByte(Integer(Src)+2)^) then
1252
          if (Source.FWidth - x > 2) and (Src^ <> PByte(Integer(Src) + 1)^) and (PByte(Integer(Src) + 1)^ = PByte(Integer(Src) + 2)^) then
909
        begin
1253
          begin
910
          {  Encoding mode }
1254
          {  Encoding mode }
911
          AllocByte^ := 1;
1255
            AllocByte^ := 1;
912
          AllocByte^ := Src^; Inc(Src);
1256
            AllocByte^ := Src^; Inc(Src);
913
          Inc(x);
1257
            Inc(x);
-
 
1258
          end
914
        end else
1259
          else
915
        begin
1260
          begin
916
          if (Source.FWidth-x<4) then
1261
            if (Source.FWidth - x < 4) then
917
          begin
1262
            begin
918
            {  Encoding mode }
1263
            {  Encoding mode }
919
            if Source.FWidth-x=2 then
1264
              if Source.FWidth - x = 2 then
Line 922... Line 1267...
922
              AllocByte^ := Src^; Inc(Src);
1267
                AllocByte^ := Src^; Inc(Src);
923
 
1268
 
924
              AllocByte^ := 1;
1269
                AllocByte^ := 1;
925
              AllocByte^ := Src^; Inc(Src);
1270
                AllocByte^ := Src^; Inc(Src);
926
              Inc(x, 2);
1271
                Inc(x, 2);
-
 
1272
              end
927
            end else
1273
              else
928
            begin
1274
              begin
929
              AllocByte^ := 1;
1275
                AllocByte^ := 1;
930
              AllocByte^ := Src^; Inc(Src);
1276
                AllocByte^ := Src^; Inc(Src);
931
              Inc(x);
1277
                Inc(x);
932
            end;
1278
              end;
-
 
1279
            end
933
          end else
1280
            else
934
          begin
1281
            begin
935
            {  Absolute mode  }
1282
            {  Absolute mode  }
936
            PB1 := Size; AllocByte;
1283
              PB1 := Size; AllocByte;
937
            PB2 := Size; AllocByte;
1284
              PB2 := Size; AllocByte;
938
 
1285
 
Line 977... Line 1324...
977
  end;
1324
  end;
978
 
1325
 
979
begin
1326
begin
980
  if Source.FCompressed then
1327
  if Source.FCompressed then
981
    Duplicate(Source, Source.FMemoryImage)
1328
    Duplicate(Source, Source.FMemoryImage)
-
 
1329
  else
982
  else begin
1330
  begin
983
    NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
1331
    NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
984
      Source.FPixelFormat, Source.FColorTable, True, True);
1332
      Source.FPixelFormat, Source.FColorTable, True, True);
985
    case FBitmapInfo.bmiHeader.biCompression of
1333
    case FBitmapInfo.bmiHeader.biCompression of
986
      BI_RLE4: EncodeRLE4;
1334
      BI_RLE4: EncodeRLE4;
987
      BI_RLE8: EncodeRLE8;
1335
      BI_RLE8: EncodeRLE8;
Line 1028... Line 1376...
1028
          for i:=0 to B2-1 do
1376
          for i := 0 to B2 - 1 do
1029
          begin
1377
          begin
1030
            if i and 1=0 then
1378
            if i and 1 = 0 then
1031
            begin
1379
            begin
1032
              C := Src^; Inc(Src);
1380
              C := Src^; Inc(Src);
-
 
1381
            end
1033
            end else
1382
            else
1034
            begin
1383
            begin
1035
              C := C shl 4;
1384
              C := C shl 4;
1036
            end;
1385
            end;
1037
 
1386
 
1038
            P := Pointer(Integer(Dest)+X shr 1);
1387
            P := Pointer(Integer(Dest) + X shr 1);
Line 1042... Line 1391...
1042
              P^ := (P^ and $F0) or ((C and $F0) shr 4);
1391
              P^ := (P^ and $F0) or ((C and $F0) shr 4);
1043
 
1392
 
1044
            Inc(X);
1393
            Inc(X);
1045
          end;
1394
          end;
1046
        end;
1395
        end;
-
 
1396
      end
1047
      end else
1397
      else
1048
      begin
1398
      begin
1049
        {  Encoding mode  }
1399
        {  Encoding mode  }
1050
        Dest := Pointer(Longint(FPBits)+Y*FWidthBytes);
1400
        Dest := Pointer(Longint(FPBits) + Y * FWidthBytes);
1051
 
1401
 
1052
        for i:=0 to B1-1 do
1402
        for i := 0 to B1 - 1 do
Line 1099... Line 1449...
1099
             end;
1449
            end;
1100
        else
1450
        else
1101
          {  Absolute mode  }
1451
          {  Absolute mode  }
1102
          Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2);
1452
          Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2);
1103
        end;
1453
        end;
-
 
1454
      end
1104
      end else
1455
      else
1105
      begin
1456
      begin
1106
        {  Encoding mode  }
1457
        {  Encoding mode  }
1107
        FillChar(Dest^, B1, B2); Inc(Dest, B1);
1458
        FillChar(Dest^, B1, B2); Inc(Dest, B1);
1108
      end;
1459
      end;
1109
 
1460
 
Line 1113... Line 1464...
1113
  end;
1464
  end;
1114
 
1465
 
1115
begin
1466
begin
1116
  if not Source.FCompressed then
1467
  if not Source.FCompressed then
1117
    Duplicate(Source, MemoryImage)
1468
    Duplicate(Source, MemoryImage)
-
 
1469
  else
1118
  else begin
1470
  begin
1119
    NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
1471
    NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
1120
      Source.FPixelFormat, Source.FColorTable, MemoryImage, False);
1472
      Source.FPixelFormat, Source.FColorTable, MemoryImage, False);
1121
    case Source.FBitmapInfo.bmiHeader.biCompression of
1473
    case Source.FBitmapInfo.bmiHeader.biCompression of
1122
      BI_RLE4: DecodeRLE4;
1474
      BI_RLE4: DecodeRLE4;
1123
      BI_RLE8: DecodeRLE8;
1475
      BI_RLE8: DecodeRLE8;
Line 1134... Line 1486...
1134
  BCRGB: array[0..255] of TRGBTriple;
1486
  BCRGB: array[0..255] of TRGBTriple;
1135
 
1487
 
1136
  procedure LoadRLE4;
1488
  procedure LoadRLE4;
1137
  begin
1489
  begin
1138
    FSize := BI.biSizeImage;
1490
    FSize := BI.biSizeImage;
-
 
1491
    //GetMem(FPBits, FSize);
1139
    FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
1492
    FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
1140
    FBitmapInfo.bmiHeader.biSizeImage := FSize;
1493
    FBitmapInfo.bmiHeader.biSizeImage := FSize;
1141
    Stream.ReadBuffer(FPBits^, FSize);
1494
    Stream.ReadBuffer(FPBits^, FSize);
1142
  end;
1495
  end;
1143
 
1496
 
1144
  procedure LoadRLE8;
1497
  procedure LoadRLE8;
1145
  begin
1498
  begin
1146
    FSize := BI.biSizeImage;
1499
    FSize := BI.biSizeImage;
-
 
1500
    //GetMem(FPBits, FSize);
1147
    FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
1501
    FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
1148
    FBitmapInfo.bmiHeader.biSizeImage := FSize;
1502
    FBitmapInfo.bmiHeader.biSizeImage := FSize;
1149
    Stream.ReadBuffer(FPBits^, FSize);
1503
    Stream.ReadBuffer(FPBits^, FSize);
1150
  end;
1504
  end;
1151
 
1505
 
Line 1155... Line 1509...
1155
  begin
1509
  begin
1156
    if BI.biHeight<0 then
1510
    if BI.biHeight < 0 then
1157
    begin
1511
    begin
1158
      for y:=0 to Abs(BI.biHeight)-1 do
1512
      for y := 0 to Abs(BI.biHeight) - 1 do
1159
        Stream.ReadBuffer(Pointer(Integer(FTopPBits)+y*FNextLine)^, FWidthBytes);
1513
        Stream.ReadBuffer(Pointer(Integer(FTopPBits) + y * FNextLine)^, FWidthBytes);
-
 
1514
    end
1160
    end else
1515
    else
1161
    begin
1516
    begin
1162
      Stream.ReadBuffer(FPBits^, FSize);
1517
      Stream.ReadBuffer(FPBits^, FSize);
1163
    end;
1518
    end;
1164
  end;
1519
  end;
1165
 
1520
 
Line 1168... Line 1523...
1168
  OS2: Boolean;
1523
  OS2: Boolean;
1169
  Localpf: TLocalDIBPixelFormat;
1524
  Localpf: TLocalDIBPixelFormat;
1170
  AColorTable: TRGBQuads;
1525
  AColorTable: TRGBQuads;
1171
  APixelFormat: TDIBPixelFormat;
1526
  APixelFormat: TDIBPixelFormat;
1172
begin
1527
begin
-
 
1528
  if not Assigned(Stream) then Exit;
-
 
1529
 
1173
  {  Header size reading  }
1530
  {  Header size reading  }
1174
  i := Stream.Read(BI.biSize, 4);
1531
  i := Stream.Read(BI.biSize, 4);
1175
 
1532
 
1176
  if i=0 then
1533
  if i = 0 then
1177
  begin
1534
  begin
-
 
1535
    {$IFNDEF D17UP}
-
 
1536
    {self recreation is not allowed here}
1178
    Create;
1537
    Create;
-
 
1538
    {$ENDIF}
1179
    Exit;
1539
    Exit;
1180
  end;
1540
  end;
1181
  if i<>4 then
1541
  if i <> 4 then
1182
    raise EInvalidGraphic.Create(SInvalidDIB);
1542
    raise EInvalidGraphic.Create(SInvalidDIB);
1183
 
1543
 
Line 1214... Line 1574...
1214
  if BI.biCompression = BI_BITFIELDS then
1574
  if BI.biCompression = BI_BITFIELDS then
1215
  begin
1575
  begin
1216
    Stream.ReadBuffer(Localpf, SizeOf(Localpf));
1576
    Stream.ReadBuffer(Localpf, SizeOf(Localpf));
1217
    with Localpf do
1577
    with Localpf do
1218
      APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask);
1578
      APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask);
-
 
1579
  end
1219
  end else
1580
  else
1220
  begin
1581
  begin
1221
    if BI.biBitCount=16 then
1582
    if BI.biBitCount = 16 then
1222
      APixelFormat := MakeDIBPixelFormat(5, 5, 5)
1583
      APixelFormat := MakeDIBPixelFormat(5, 5, 5)
1223
    else if BI.biBitCount=32 then
1584
    else if BI.biBitCount = 32 then
1224
      APixelFormat := MakeDIBPixelFormat(8, 8, 8)
1585
      APixelFormat := MakeDIBPixelFormat(8, 8, 8)
Line 1241... Line 1602...
1241
    for i:=0 to PalCount-1 do
1602
    for i := 0 to PalCount - 1 do
1242
    begin
1603
    begin
1243
      with BCRGB[i] do
1604
      with BCRGB[i] do
1244
        AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue);
1605
        AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue);
1245
    end;
1606
    end;
-
 
1607
  end
1246
  end else
1608
  else
1247
  begin
1609
  begin
1248
    {  Windows type  }
1610
    {  Windows type  }
1249
    Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad)*PalCount);
1611
    Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad) * PalCount);
1250
  end;
1612
  end;
1251
 
1613
 
1252
  {  DIB ì¬  }
1614
  {  DIB compilation  }
1253
  NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable,
1615
  NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable,
1254
    MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]);
1616
    MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]);
1255
 
1617
 
1256
  {  Pixel data reading  }
1618
  {  Pixel data reading  }
1257
  case BI.biCompression of
1619
  case BI.biCompression of
Line 1268... Line 1630...
1268
begin
1630
begin
1269
  if FHandle<>0 then
1631
  if FHandle <> 0 then
1270
  begin
1632
  begin
1271
    if FOldHandle<>0 then SelectObject(FDC, FOldHandle);
1633
    if FOldHandle <> 0 then SelectObject(FDC, FOldHandle);
1272
    DeleteObject(FHandle);
1634
    DeleteObject(FHandle);
-
 
1635
  end
1273
  end else
1636
  else
-
 
1637
//    GlobalFree(THandle(FPBits));
1274
  begin
1638
  begin
1275
    if FPBits<>nil then
1639
    if FPBits <> nil then
1276
      GlobalFreePtr(FPBits);
1640
      GlobalFreePtr(FPBits);
1277
  end;
1641
  end;
1278
 
1642
 
Line 1331... Line 1695...
1331
 
1695
 
1332
constructor TDIB.Create;
1696
constructor TDIB.Create;
1333
begin
1697
begin
1334
  inherited Create;
1698
  inherited Create;
1335
  SetImage(EmptyDIBImage);
1699
  SetImage(EmptyDIBImage);
-
 
1700
 
-
 
1701
  FFreeList := TList.Create;
1336
end;
1702
end;
1337
 
1703
 
1338
destructor TDIB.Destroy;
1704
destructor TDIB.Destroy;
-
 
1705
var
-
 
1706
  D: TDIB;
1339
begin
1707
begin
1340
  SetImage(EmptyDIBImage);
1708
  SetImage(EmptyDIBImage);
1341
  FCanvas.Free;
1709
  FCanvas.Free;
-
 
1710
 
-
 
1711
  while FFreeList.Count > 0 do
-
 
1712
  try
-
 
1713
    D := TDIB(FFreeList[0]);
-
 
1714
    FFreeList.Remove(D);
-
 
1715
    D.Free;
-
 
1716
  except
-
 
1717
  end;
-
 
1718
  FFreeList.Free;
-
 
1719
 
1342
  inherited Destroy;
1720
  inherited Destroy;
1343
end;
1721
end;
1344
 
1722
 
1345
procedure TDIB.Assign(Source: TPersistent);
1723
procedure TDIB.Assign(Source: TPersistent);
1346
 
1724
 
Line 1370... Line 1748...
1370
          begin
1748
        begin
1371
            DIBSectionRec := @Data;
1749
          DIBSectionRec := @Data;
1372
            if DIBSectionRec^.dsBm.bmBitsPixel>=24 then
1750
          if DIBSectionRec^.dsBm.bmBitsPixel >= 24 then
1373
            begin
1751
          begin
1374
              PixelFormat := MakeDIBPixelFormat(8, 8, 8);
1752
            PixelFormat := MakeDIBPixelFormat(8, 8, 8);
-
 
1753
          end
1375
            end else
1754
          else
1376
            if DIBSectionRec^.dsBm.bmBitsPixel>8 then
1755
            if DIBSectionRec^.dsBm.bmBitsPixel > 8 then
1377
            begin
1756
            begin
1378
              PixelFormat := MakeDIBPixelFormat(DIBSectionRec^.dsBitfields[0],
1757
              PixelFormat := MakeDIBPixelFormatMask(DIBSectionRec^.dsBitfields[0], //correct I.Ceneff, thanks
1379
                DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]);
1758
                DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]);
-
 
1759
            end
1380
            end else
1760
            else
1381
            begin
1761
            begin
1382
              PixelFormat := MakeDIBPixelFormat(8, 8, 8);
1762
              PixelFormat := MakeDIBPixelFormat(8, 8, 8);
1383
            end;
1763
            end;
1384
            SetSize(DIBSectionRec^.dsBm.bmWidth, DIBSectionRec^.dsBm.bmHeight,
1764
          SetSize(DIBSectionRec^.dsBm.bmWidth, DIBSectionRec^.dsBm.bmHeight,
1385
              DIBSectionRec^.dsBm.bmBitsPixel);
1765
            DIBSectionRec^.dsBm.bmBitsPixel);
Line 1391... Line 1771...
1391
    FillChar(PBits^, Size, 0);
1771
    FillChar(PBits^, Size, 0);
1392
    Canvas.Draw(0, 0, Source);
1772
    Canvas.Draw(0, 0, Source);
1393
  end;
1773
  end;
1394
 
1774
 
1395
  procedure AssignGraphic(Source: TGraphic);
1775
  procedure AssignGraphic(Source: TGraphic);
-
 
1776
  {$IFDEF PNG_GRAPHICS}
-
 
1777
  var
-
 
1778
    alpha: TDIB;
-
 
1779
    png: {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF};
-
 
1780
    i, j: Integer;
-
 
1781
    q: pByteArray;
-
 
1782
  {$ENDIF}
-
 
1783
  begin
-
 
1784
    {$IFDEF PNG_GRAPHICS}
-
 
1785
    if Source is {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF} then
-
 
1786
    begin
-
 
1787
      alpha := TDIB.Create;
-
 
1788
      try
-
 
1789
        {png image}
-
 
1790
        png := {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF}.Create;
-
 
1791
        try
-
 
1792
          png.Assign(Source);
-
 
1793
          if png.TransparencyMode = ptmPartial then
1396
  begin
1794
          begin
-
 
1795
            Alpha.SetSize(png.Width, png.Height, 8);
-
 
1796
            {separate alpha}
-
 
1797
            for i := 0 to png.Height - 1 do
-
 
1798
            begin
-
 
1799
              q := png.AlphaScanline[i];
-
 
1800
              for j := 0 to png.Width - 1 do
-
 
1801
                alpha.Pixels[j,i] := q[j];
-
 
1802
            end;
-
 
1803
          end;
-
 
1804
          SetSize(png.Width, png.Height, 32);
-
 
1805
          FillChar(PBits^, Size, 0);
-
 
1806
          Canvas.Draw(0, 0, png);
-
 
1807
          Transparent := png.Transparent;
-
 
1808
        finally
-
 
1809
          png.Free;
-
 
1810
        end;
-
 
1811
        if not alpha.Empty then
-
 
1812
          AssignAlphaChannel(alpha);
-
 
1813
      finally
-
 
1814
        alpha.Free;
-
 
1815
      end;
-
 
1816
    end
-
 
1817
    else
-
 
1818
    {$ENDIF}
1397
    if Source is TBitmap then
1819
    if Source is TBitmap then
1398
      AssignBitmap(TBitmap(Source))
1820
      AssignBitmap(TBitmap(Source))
1399
    else
1821
    else
1400
    begin
1822
    begin
-
 
1823
      SetSize(Source.Width, Source.Height, 32);
-
 
1824
      FillChar(PBits^, Size, 0);
-
 
1825
      Canvas.Draw(0, 0, Source);
-
 
1826
      Transparent := Source.Transparent;
-
 
1827
      if not HasAlphaChannel then
-
 
1828
      begin
1401
      SetSize(Source.Width, Source.Height, 24);
1829
        SetSize(Source.Width, Source.Height, 24);
1402
      FillChar(PBits^, Size, 0);
1830
        FillChar(PBits^, Size, 0);
1403
      Canvas.Draw(0, 0, Source);
1831
        Canvas.Draw(0, 0, Source);
-
 
1832
        Transparent := Source.Transparent;
-
 
1833
      end
1404
    end;
1834
    end;
1405
  end;
1835
  end;
1406
 
1836
 
1407
begin
1837
begin
1408
  if Source=nil then
1838
  if Source = nil then
Line 1423... Line 1853...
1423
      Clear;
1853
      Clear;
1424
  end else
1854
  end else
1425
    inherited Assign(Source);
1855
    inherited Assign(Source);
1426
end;
1856
end;
1427
 
1857
 
1428
procedure TDIB.Draw(ACanvas: TCanvas; const Rect: TRect);
1858
procedure TDIB.Draw(ACanvas: TCanvas; const ARect: TRect);
1429
var
1859
var
1430
  OldPalette: HPalette;
1860
  OldPalette: HPalette;
1431
  OldMode: Integer;
1861
  OldMode: Integer;
1432
begin
1862
begin
1433
  if Size>0 then
1863
  if Size > 0 then
1434
  begin
1864
  begin
1435
    if PaletteCount>0 then
1865
    if PaletteCount > 0 then
1436
    begin
1866
    begin
1437
      OldPalette := SelectPalette(ACanvas.Handle, Palette, False);
1867
      OldPalette := SelectPalette(ACanvas.Handle, Palette, False);
1438
      RealizePalette(ACanvas.Handle);
1868
      RealizePalette(ACanvas.Handle);
-
 
1869
    end
1439
    end else
1870
    else
1440
      OldPalette := 0;
1871
      OldPalette := 0;
1441
    try
1872
    try
1442
      OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR);
1873
      OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR);
1443
      try
1874
      try
1444
        GdiFlush;
1875
        GdiFlush;
1445
        if FImage.FMemoryImage then
1876
        if FImage.FMemoryImage then
1446
        begin
1877
        begin
1447
          with Rect do
1878
          with ARect do
-
 
1879
          begin
1448
            StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
1880
            if StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
1449
              0, 0, Width, Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS , ACanvas.CopyMode);
1881
              0, 0, Self.Width, Self.Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS, ACanvas.CopyMode) = 0 then
-
 
1882
               MessageBeep(1);
-
 
1883
          end;
-
 
1884
        end
1450
        end else
1885
        else
1451
        begin
1886
        begin
1452
          with Rect do
1887
          with ARect do
1453
            StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
1888
            StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
1454
              FImage.FDC, 0, 0, Width, Height, ACanvas.CopyMode);
1889
              FImage.FDC, 0, 0, Self.Width, Self.Height, ACanvas.CopyMode);
1455
        end;
1890
        end;
1456
      finally
1891
      finally
1457
        SetStretchBltMode(ACanvas.Handle, OldMode);
1892
        SetStretchBltMode(ACanvas.Handle, OldMode);
1458
      end;
1893
      end;
1459
    finally
1894
    finally
Line 1555... Line 1990...
1555
    end;
1990
    end;
1556
    SetImage(TempImage);
1991
    SetImage(TempImage);
1557
  end;
1992
  end;
1558
end;
1993
end;
1559
 
1994
 
-
 
1995
type
-
 
1996
  PRGBA = ^TRGBA;
-
 
1997
  TRGBA = array[0..0] of Windows.TRGBQuad;
-
 
1998
 
-
 
1999
function TDIB.HasAlphaChannel: Boolean;
-
 
2000
  {give that DIB contain the alphachannel}
-
 
2001
var
-
 
2002
  p: PRGBA;
-
 
2003
  X, Y: Integer;
-
 
2004
begin
-
 
2005
  Result := True;
-
 
2006
  if BitCount = 32 then
-
 
2007
    for Y := 0 to Height - 1 do
-
 
2008
    begin
-
 
2009
      p := ScanLine[Y];
-
 
2010
      for X := 0 to Width - 1 do
-
 
2011
      begin
-
 
2012
        if p[X].rgbReserved <> $0 then Exit;
-
 
2013
      end
-
 
2014
    end;
-
 
2015
  Result := False;
-
 
2016
end;
-
 
2017
 
-
 
2018
function TDIB.AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
-
 
2019
  {copy alphachannel from other DIB or add from DIB8}
-
 
2020
var
-
 
2021
  p32_0, p32_1: PRGBA;
-
 
2022
  p24: Pointer;
-
 
2023
  pB: PArrayByte;
-
 
2024
  X, Y: Integer;
-
 
2025
  tmpDIB, qAlpha: TDIB;
-
 
2026
begin
-
 
2027
  Result := False;
-
 
2028
  if GetEmpty then Exit;
-
 
2029
  {Alphachannel can be copy into 32bit DIB only!}
-
 
2030
  if BitCount <> 32 then
-
 
2031
  begin
-
 
2032
    tmpDIB := TDIB.Create;
-
 
2033
    try
-
 
2034
      tmpDIB.Assign(Self);
-
 
2035
      Clear;
-
 
2036
      SetSize(tmpDIB.Width, tmpDIB.Height, 32);
-
 
2037
      Canvas.Draw(0, 0, tmpDIB);
-
 
2038
    finally
-
 
2039
      tmpDIB.Free;
-
 
2040
    end;
-
 
2041
  end;
-
 
2042
  qAlpha := TDIB.Create;
-
 
2043
  try
-
 
2044
    if not Assigned(Alpha) then Exit;
-
 
2045
    if ForceResize then
-
 
2046
    begin
-
 
2047
      {create temp}
-
 
2048
      tmpDIB := TDIB.Create;
-
 
2049
      try
-
 
2050
        {picture}
-
 
2051
        tmpDIB.Assign(ALPHA);
-
 
2052
        {resample size}
-
 
2053
        tmpDIB.DoResample(Width, Height, ftrBSpline);
-
 
2054
        {convert to greyscale}
-
 
2055
        tmpDIB.Greyscale(8);
-
 
2056
        {return picture to qAlpha}
-
 
2057
        qAlpha.Assign(tmpDIB);
-
 
2058
      finally
-
 
2059
        tmpDIB.Free;
-
 
2060
      end;
-
 
2061
    end
-
 
2062
    else
-
 
2063
      {Must be the same size!}
-
 
2064
      if not ((Width = ALPHA.Width) and (Height = ALPHA.Height)) then Exit
-
 
2065
      else qAlpha.Assign(ALPHA);
-
 
2066
    {It works now with qAlpha only}
-
 
2067
    case qAlpha.BitCount of
-
 
2068
      24:
-
 
2069
        begin
-
 
2070
          for Y := 0 to Height - 1 do
-
 
2071
          begin
-
 
2072
            p32_0 := ScanLine[Y];
-
 
2073
            p24 := qAlpha.ScanLine[Y];
-
 
2074
            for X := 0 to Width - 1 do with PBGR(p24)^ do
-
 
2075
            begin
-
 
2076
                p32_0[X].rgbReserved := Round(0.30 * R + 0.59 * G + 0.11 * B);
-
 
2077
              end
-
 
2078
          end;
-
 
2079
        end;
-
 
2080
      32:
-
 
2081
        begin
-
 
2082
          for Y := 0 to Height - 1 do
-
 
2083
          begin
-
 
2084
            p32_0 := ScanLine[Y];
-
 
2085
            p32_1 := qAlpha.ScanLine[Y];
-
 
2086
            for X := 0 to Width - 1 do
-
 
2087
            begin
-
 
2088
              p32_0[X].rgbReserved := p32_1[X].rgbReserved;
-
 
2089
            end
-
 
2090
          end;
-
 
2091
        end;
-
 
2092
      8:
-
 
2093
        begin
-
 
2094
          for Y := 0 to Height - 1 do
-
 
2095
          begin
-
 
2096
            p32_0 := ScanLine[Y];
-
 
2097
            pB := qAlpha.ScanLine[Y];
-
 
2098
            for X := 0 to Width - 1 do
-
 
2099
            begin
-
 
2100
              p32_0[X].rgbReserved := pB[X];
-
 
2101
            end
-
 
2102
          end;
-
 
2103
        end;
-
 
2104
      1:
-
 
2105
        begin
-
 
2106
          for Y := 0 to Height - 1 do
-
 
2107
          begin
-
 
2108
            p32_0 := ScanLine[Y];
-
 
2109
            pB := qAlpha.ScanLine[Y];
-
 
2110
            for X := 0 to Width - 1 do
-
 
2111
            begin
-
 
2112
              if pB[X] = 0 then
-
 
2113
                p32_0[X].rgbReserved := $FF
-
 
2114
              else
-
 
2115
                p32_0[X].rgbReserved := 0
-
 
2116
            end
-
 
2117
          end;
-
 
2118
        end;
-
 
2119
    else
-
 
2120
      Exit;
-
 
2121
    end;
-
 
2122
    Result := True;
-
 
2123
  finally
-
 
2124
    qAlpha.Free;
-
 
2125
  end;
-
 
2126
end;
-
 
2127
 
-
 
2128
procedure TDIB.RetAlphaChannel(out oDIB: TDIB);
-
 
2129
  {Store alphachannel information into DIB8}
-
 
2130
var
-
 
2131
  p0: PRGBA;
-
 
2132
  pB: PArrayByte;
-
 
2133
  X, Y: Integer;
-
 
2134
begin
-
 
2135
  oDIB := nil;
-
 
2136
  if not HasAlphaChannel then exit;
-
 
2137
  oDIB := TDIB.Create;
-
 
2138
  oDIB.SetSize(Width, Height, 8);
-
 
2139
  for Y := 0 to Height - 1 do
-
 
2140
  begin
-
 
2141
    p0 := ScanLine[Y];
-
 
2142
    pB := oDIB.ScanLine[Y];
-
 
2143
    for X := 0 to Width - 1 do
-
 
2144
    begin
-
 
2145
      pB[X] := p0[X].rgbReserved;
-
 
2146
    end
-
 
2147
  end;
-
 
2148
end;
-
 
2149
 
1560
function TDIB.GetBitmapInfo: PBitmapInfo;
2150
function TDIB.GetBitmapInfo: PBitmapInfo;
1561
begin
2151
begin
1562
  Result := FImage.FBitmapInfo;
2152
  Result := FImage.FBitmapInfo;
1563
end;
2153
end;
1564
 
2154
 
Line 1681... Line 2271...
1681
  Result := 0;
2271
  Result := 0;
1682
  if (X>=0) and (X<FWidth) and (Y>=0) and (Y<FHeight) then
2272
  if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
1683
  begin
2273
  begin
1684
    case FBitCount of
2274
    case FBitCount of
1685
      1 : Result := (PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
2275
      1: Result := (PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
1686
      4 : Result := (PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1];
2276
      4: Result := ((PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]);
1687
      8 : Result := PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X];
2277
      8: Result := PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X];
1688
      16: Result := PArrayWord(Integer(FTopPBits)+Y*FNextLine)[X];
2278
      16: Result := PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X];
1689
      24: with PArrayBGR(Integer(FTopPBits)+Y*FNextLine)[X] do
2279
      24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do
1690
            Result := R or (G shl 8) or (B shl 16);
2280
          Result := R or (G shl 8) or (B shl 16);
1691
      32: Result := PArrayDWord(Integer(FTopPBits)+Y*FNextLine)[X];
2281
      32: Result := PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X];
1692
    end;
2282
    end;
1693
  end;
2283
  end;
1694
end;
2284
end;
1695
 
2285
 
-
 
2286
function TDIB.GetRGBChannel: TDIB;
-
 
2287
  {Store RGB channel information into DIB24}
-
 
2288
begin
-
 
2289
  Result := nil;
-
 
2290
  if Self.Empty then Exit;
-
 
2291
  Result := TDIB.Create;
-
 
2292
  Result.SetSize(Width, Height, 24);
-
 
2293
  Self.DrawOn(Bounds(0,0, Self.Width, Self.Height), Result.Canvas, 0, 0);
-
 
2294
  FFreeList.Add(Result);
-
 
2295
end;
-
 
2296
 
1696
procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD);
2297
procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD);
1697
var
2298
var
1698
  P: PByte;
2299
  P: PByte;
1699
begin
2300
begin
1700
  Changing(True);
2301
  Changing(True);
Line 1705... Line 2306...
1705
      1 : begin
2306
      1: begin
1706
            P := @PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 3];
2307
          P := @PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3];
1707
            P^ := (P^ and Mask1n[X and 7]) or ((Value and 1) shl Shift1[X and 7]);
2308
          P^ := (P^ and Mask1n[X and 7]) or ((Value and 1) shl Shift1[X and 7]);
1708
          end;
2309
        end;
1709
      4 : begin
2310
      4: begin
1710
            P := @PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 3];
2311
          P := (@PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3]);
1711
            P^ := (P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1]);
2312
          P^ := ((P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1]));
1712
          end;
2313
        end;
1713
      8 : PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X] := Value;
2314
      8: PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X] := Value;
1714
      16: PArrayWord(Integer(FTopPBits)+Y*FNextLine)[X] := Value;
2315
      16: PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value;
1715
      24: with PArrayBGR(Integer(FTopPBits)+Y*FNextLine)[X] do
2316
      24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do
1716
          begin
2317
        begin
Line 1721... Line 2322...
1721
      32: PArrayDWord(Integer(FTopPBits)+Y*FNextLine)[X] := Value;
2322
      32: PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value;
1722
    end;
2323
    end;
1723
  end;
2324
  end;
1724
end;
2325
end;
1725
                           
2326
 
-
 
2327
procedure TDIB.SetRGBChannel(const Value: TDIB);
-
 
2328
var
-
 
2329
  alpha: TDIB;
-
 
2330
begin
-
 
2331
  if Self.HasAlphaChannel then
-
 
2332
  try
-
 
2333
    RetAlphaChannel(alpha);
-
 
2334
    Self.SetSize(Value.Width, Value.Height, 32);
-
 
2335
    Value.DrawOn(Bounds(0,0,Value.Width, Value.Height), Self.Canvas, 0, 0);
-
 
2336
    Self.AssignAlphaChannel(alpha, True);
-
 
2337
  finally
-
 
2338
    alpha.Free;
-
 
2339
  end
-
 
2340
  else
-
 
2341
    Self.Assign(Value);
-
 
2342
end;
-
 
2343
 
1726
procedure TDIB.DefineProperties(Filer: TFiler);
2344
procedure TDIB.DefineProperties(Filer: TFiler);
1727
begin
2345
begin
1728
  inherited DefineProperties(Filer);
2346
  inherited DefineProperties(Filer);
1729
  {  For interchangeability with an old version.  }
2347
  {  For interchangeability with an old version.  }
1730
  Filer.DefineBinaryProperty('DIB', LoadFromStream, nil, False);
2348
  Filer.DefineBinaryProperty('DIB', LoadFromStream, nil, False);
1731
end;
2349
end;
1732
 
2350
 
1733
type
2351
type
-
 
2352
  {  TGlobalMemoryStream  }
-
 
2353
 
1734
  TGlobalMemoryStream = class(TMemoryStream)
2354
  TGlobalMemoryStream = class(TMemoryStream)
1735
  private
2355
  private
1736
    FHandle: THandle;
2356
    FHandle: THandle;
1737
  public
2357
  public
1738
    constructor Create(AHandle: THandle);
2358
    constructor Create(AHandle: THandle);
Line 1771... Line 2391...
1771
 
2391
 
1772
procedure TDIB.LoadFromStream(Stream: TStream);
2392
procedure TDIB.LoadFromStream(Stream: TStream);
1773
var
2393
var
1774
  BF: TBitmapFileHeader;
2394
  BF: TBitmapFileHeader;
1775
  i: Integer;
2395
  i: Integer;
-
 
2396
  ImageJPEG: TJPEGImage;
1776
begin
2397
begin
1777
  {  File header reading  }
2398
  {  File header reading  }
1778
  i := Stream.Read(BF, SizeOf(TBitmapFileHeader));
2399
  i := Stream.Read(BF, SizeOf(TBitmapFileHeader));
1779
  if i=0 then Exit;
2400
  if i = 0 then Exit;
1780
  if i<>SizeOf(TBitmapFileHeader) then
2401
  if i <> SizeOf(TBitmapFileHeader) then
1781
    raise EInvalidGraphic.Create(SInvalidDIB);
2402
    raise EInvalidGraphic.Create(SInvalidDIB);
1782
 
2403
 
-
 
2404
  {  Is the head jpeg ?}
-
 
2405
 
-
 
2406
  if BF.bfType = $D8FF then
-
 
2407
  begin
-
 
2408
    ImageJPEG := TJPEGImage.Create;
-
 
2409
    try
-
 
2410
      try
-
 
2411
        Stream.Position := 0;
-
 
2412
        ImageJPEG.LoadFromStream(Stream);
-
 
2413
      except
-
 
2414
        on EInvalidGraphic do ImageJPEG := nil;
-
 
2415
      end;
-
 
2416
      if ImageJPEG <> nil then
-
 
2417
      begin
-
 
2418
        {set size and bitcount in natural units of jpeg}
-
 
2419
        SetSize(ImageJPEG.Width, ImageJPEG.Height, 24);
-
 
2420
        Canvas.Draw(0, 0, ImageJPEG);
-
 
2421
        Exit
-
 
2422
      end;
-
 
2423
    finally
-
 
2424
      ImageJPEG.Free;
-
 
2425
    end;
-
 
2426
  end
-
 
2427
  else
1783
  {  Is the head 'BM'?  }
2428
  {  Is the head 'BM'?  }
1784
  if BF.bfType<>BitmapFileType then
2429
    if BF.bfType <> BitmapFileType then
1785
    raise EInvalidGraphic.Create(SInvalidDIB);
2430
      raise EInvalidGraphic.Create(SInvalidDIB);
1786
 
2431
 
1787
  ReadData(Stream);
2432
  ReadData(Stream);
Line 1862... Line 2507...
1862
  else
2507
  else
1863
  begin
2508
  begin
1864
    if Empty then
2509
    if Empty then
1865
    begin
2510
    begin
1866
      SetSize(Max(Width, 1), Max(Height, 1), Value)
2511
      SetSize(Max(Width, 1), Max(Height, 1), Value)
-
 
2512
    end
1867
    end else
2513
    else
1868
    begin
2514
    begin
1869
      ConvertBitCount(Value);
2515
      ConvertBitCount(Value);
1870
    end;
2516
    end;
1871
  end;
2517
  end;
1872
end;
2518
end;
Line 2029... Line 2675...
2029
      DestP := ScanLine[y];
2675
      DestP := ScanLine[y];
2030
 
2676
 
2031
      for x:=0 to Width-1 do
2677
      for x := 0 to Width - 1 do
2032
      begin
2678
      begin
2033
        case Temp.BitCount of
2679
        case Temp.BitCount of
-
 
2680
          1:
2034
          1 : begin
2681
            begin
2035
                i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
2682
              i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
2036
              end;
2683
            end;
-
 
2684
          4:
2037
          4 : begin
2685
            begin
2038
                i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1];
2686
              i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1];
2039
              end;
2687
            end;
-
 
2688
          8:
2040
          8 : begin
2689
            begin
2041
                i := PByte(SrcP)^;
2690
              i := PByte(SrcP)^;
2042
                Inc(PByte(SrcP));
2691
              Inc(PByte(SrcP));
2043
              end;
2692
            end;
2044
        end;
2693
        end;
2045
 
2694
 
2046
        case BitCount of
2695
        case BitCount of
-
 
2696
          1:
2047
          1 : begin
2697
            begin
2048
                P := @PArrayByte(DestP)[X shr 3];
2698
              P := @PArrayByte(DestP)[X shr 3];
2049
                P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]);
2699
              P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]);
2050
              end;
2700
            end;
-
 
2701
          4:
2051
          4 : begin
2702
            begin
2052
                P := @PArrayByte(DestP)[X shr 1];
2703
              P := @PArrayByte(DestP)[X shr 1];
2053
                P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]);
2704
              P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]);
2054
              end;
2705
            end;
-
 
2706
          8:
2055
          8 : begin
2707
            begin
2056
                PByte(DestP)^ := i;
2708
              PByte(DestP)^ := i;
2057
                Inc(PByte(DestP));
2709
              Inc(PByte(DestP));
2058
              end;
2710
            end;
2059
        end;
2711
        end;
2060
      end;
2712
      end;
Line 2077... Line 2729...
2077
      DestP := ScanLine[y];
2729
      DestP := ScanLine[y];
2078
 
2730
 
2079
      for x:=0 to Width-1 do
2731
      for x := 0 to Width - 1 do
2080
      begin
2732
      begin
2081
        case Temp.BitCount of
2733
        case Temp.BitCount of
-
 
2734
          1:
2082
          1 : begin
2735
            begin
2083
                with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do
2736
              with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do
2084
                begin
2737
              begin
2085
                  cR := rgbRed;
2738
                cR := rgbRed;
2086
                  cG := rgbGreen;
2739
                cG := rgbGreen;
2087
                  cB := rgbBlue;
2740
                cB := rgbBlue;
2088
                end;
2741
              end;
2089
              end;
2742
            end;
-
 
2743
          4:
2090
          4 : begin
2744
            begin
2091
                with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do
2745
              with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do
2092
                begin
2746
              begin
2093
                  cR := rgbRed;
2747
                cR := rgbRed;
2094
                  cG := rgbGreen;
2748
                cG := rgbGreen;
2095
                  cB := rgbBlue;
2749
                cB := rgbBlue;
2096
                end;
2750
              end;
2097
              end;
2751
            end;
-
 
2752
          8:
2098
          8 : begin
2753
            begin
2099
                with Temp.ColorTable[PByte(SrcP)^] do
2754
              with Temp.ColorTable[PByte(SrcP)^] do
2100
                begin
2755
              begin
2101
                  cR := rgbRed;
2756
                cR := rgbRed;
2102
                  cG := rgbGreen;
2757
                cG := rgbGreen;
2103
                  cB := rgbBlue;
2758
                cB := rgbBlue;
2104
                end;
2759
              end;
2105
                Inc(PByte(SrcP));
2760
              Inc(PByte(SrcP));
2106
              end;
2761
            end;
-
 
2762
          16:
2107
          16: begin
2763
            begin
2108
                pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB);
2764
              pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB);
2109
                Inc(PWord(SrcP));
2765
              Inc(PWord(SrcP));
2110
              end;
2766
            end;
-
 
2767
          24:
2111
          24: begin
2768
            begin
2112
                with PBGR(SrcP)^ do
2769
              with PBGR(SrcP)^ do
2113
                begin
2770
              begin
2114
                  cR := R;
2771
                cR := R;
2115
                  cG := G;
2772
                cG := G;
2116
                  cB := B;
2773
                cB := B;
2117
                end;
2774
              end;
2118
 
2775
 
2119
                Inc(PBGR(SrcP));
2776
              Inc(PBGR(SrcP));
2120
              end;
2777
            end;
-
 
2778
          32:
2121
          32: begin
2779
            begin
2122
                pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB);
2780
              pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB);
2123
                Inc(PDWORD(SrcP));
2781
              Inc(PDWORD(SrcP));
2124
              end;
2782
            end;
2125
        end;
2783
        end;
2126
 
2784
 
2127
        case BitCount of
2785
        case BitCount of
-
 
2786
          16:
2128
          16: begin
2787
            begin
2129
                PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
2788
              PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
2130
                Inc(PWord(DestP));
2789
              Inc(PWord(DestP));
2131
              end;
2790
            end;
-
 
2791
          24:
2132
          24: begin
2792
            begin
2133
                with PBGR(DestP)^ do
2793
              with PBGR(DestP)^ do
2134
                begin
2794
              begin
2135
                  R := cR;
2795
                R := cR;
2136
                  G := cG;
2796
                G := cG;
2137
                  B := cB;
2797
                B := cB;
2138
                end;
2798
              end;
2139
                Inc(PBGR(DestP));
2799
              Inc(PBGR(DestP));
2140
              end;
2800
            end;
-
 
2801
          32:
2141
          32: begin
2802
            begin
2142
                PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
2803
              PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
2143
                Inc(PDWORD(DestP));
2804
              Inc(PDWORD(DestP));
2144
              end;
2805
            end;
2145
        end;
2806
        end;
2146
      end;
2807
      end;
Line 2161... Line 2822...
2161
    begin
2822
    begin
2162
      {  The image is converted from the palette color image into the palette color image.  }
2823
      {  The image is converted from the palette color image into the palette color image.  }
2163
      if Temp.BitCount<=BitCount then
2824
      if Temp.BitCount <= BitCount then
2164
      begin
2825
      begin
2165
        PaletteToPalette_Inc;
2826
        PaletteToPalette_Inc;
-
 
2827
      end
2166
      end else
2828
      else
2167
      begin
2829
      begin
2168
        case BitCount of
2830
        case BitCount of
2169
          1: begin
2831
          1: begin
2170
               ColorTable[0] := RGBQuad(0, 0, 0);
2832
              ColorTable[0] := RGBQuad(0, 0, 0);
2171
               ColorTable[1] := RGBQuad(255, 255, 255);
2833
              ColorTable[1] := RGBQuad(255, 255, 255);
Line 2175... Line 2837...
2175
        end;
2837
        end;
2176
        UpdatePalette;
2838
        UpdatePalette;
2177
 
2839
 
2178
        Canvas.Draw(0, 0, Temp);
2840
        Canvas.Draw(0, 0, Temp);
2179
      end;
2841
      end;
-
 
2842
    end
2180
    end else
2843
    else
2181
    if (Temp.BitCount<=8) and (BitCount>8) then
2844
      if (Temp.BitCount <= 8) and (BitCount > 8) then
2182
    begin
2845
      begin
2183
      {  The image is converted from the palette color image into the rgb color image.  }
2846
{  The image is converted from the palette color image into the rgb color image.  }
2184
      PaletteToRGB_or_RGBToRGB;
2847
        PaletteToRGB_or_RGBToRGB;
-
 
2848
      end
2185
    end else
2849
      else
2186
    if (Temp.BitCount>8) and (BitCount<=8) then
2850
        if (Temp.BitCount > 8) and (BitCount <= 8) then
2187
    begin
2851
        begin
2188
      {  The image is converted from the rgb color image into the palette color image.  }
2852
{ The image is converted from the rgb color image into the palette color image.  }
2189
      case BitCount of
2853
          case BitCount of
2190
        1: begin
2854
            1: begin
Line 2195... Line 2859...
2195
        8: CreateHalftonePalette(3, 3, 2);
2859
            8: CreateHalftonePalette(3, 3, 2);
2196
      end;
2860
          end;
2197
      UpdatePalette;
2861
          UpdatePalette;
2198
 
2862
 
2199
      Canvas.Draw(0, 0, Temp);
2863
          Canvas.Draw(0, 0, Temp);
-
 
2864
        end
2200
    end else
2865
        else
2201
    if (Temp.BitCount>8) and (BitCount>8) then
2866
          if (Temp.BitCount > 8) and (BitCount > 8) then
2202
    begin
2867
          begin
2203
      {  The image is converted from the rgb color image into the rgb color image.  }
2868
 {  The image is converted from the rgb color image into the rgb color image.  }
2204
      PaletteToRGB_or_RGBToRGB;
2869
            PaletteToRGB_or_RGBToRGB;
2205
    end;
2870
          end;
Line 2249... Line 2914...
2249
  end;
2914
  end;
2250
 
2915
 
2251
  Inc(FProgressY);
2916
  Inc(FProgressY);
2252
end;
2917
end;
2253
 
2918
 
-
 
2919
procedure TDIB.Mirror(MirrorX, MirrorY: Boolean);
-
 
2920
var
-
 
2921
  x, y, Width2, c: Integer;
-
 
2922
  P1, P2, TempBuf: Pointer;
-
 
2923
begin
-
 
2924
  if Empty then Exit;
-
 
2925
  if (not MirrorX) and (not MirrorY) then Exit;
-
 
2926
 
-
 
2927
  if (not MirrorX) and (MirrorY) then
-
 
2928
  begin
-
 
2929
    GetMem(TempBuf, WidthBytes);
-
 
2930
    try
-
 
2931
      StartProgress('Mirror');
-
 
2932
      try
-
 
2933
        for y := 0 to Height shr 1 - 1 do
-
 
2934
        begin
-
 
2935
          P1 := ScanLine[y];
-
 
2936
          P2 := ScanLine[Height - y - 1];
-
 
2937
 
-
 
2938
          Move(P1^, TempBuf^, WidthBytes);
-
 
2939
          Move(P2^, P1^, WidthBytes);
-
 
2940
          Move(TempBuf^, P2^, WidthBytes);
-
 
2941
 
-
 
2942
          UpdateProgress(y * 2);
-
 
2943
        end;
-
 
2944
      finally
-
 
2945
        EndProgress;
-
 
2946
      end;
-
 
2947
    finally
-
 
2948
      FreeMem(TempBuf, WidthBytes);
-
 
2949
    end;
-
 
2950
  end
-
 
2951
  else
-
 
2952
  if (MirrorX) and (not MirrorY) then
-
 
2953
  begin
-
 
2954
    Width2 := Width shr 1;
-
 
2955
 
-
 
2956
    StartProgress('Mirror');
-
 
2957
    try
-
 
2958
      for y := 0 to Height - 1 do
-
 
2959
      begin
-
 
2960
        P1 := ScanLine[y];
-
 
2961
 
-
 
2962
        case BitCount of
-
 
2963
          1:
-
 
2964
            begin
-
 
2965
              for x := 0 to Width2 - 1 do
-
 
2966
              begin
-
 
2967
                c := Pixels[x, y];
-
 
2968
                Pixels[x, y] := Pixels[Width - x - 1, y];
-
 
2969
                Pixels[Width - x - 1, y] := c;
-
 
2970
              end;
-
 
2971
            end;
-
 
2972
          4:
-
 
2973
            begin
-
 
2974
              for x := 0 to Width2 - 1 do
-
 
2975
              begin
-
 
2976
                c := Pixels[x, y];
-
 
2977
                Pixels[x, y] := Pixels[Width - x - 1, y];
-
 
2978
                Pixels[Width - x - 1, y] := c;
-
 
2979
              end;
-
 
2980
            end;
-
 
2981
          8:
-
 
2982
            begin
-
 
2983
              P2 := Pointer(Integer(P1) + Width - 1);
-
 
2984
              for x := 0 to Width2 - 1 do
-
 
2985
              begin
-
 
2986
                PByte(@c)^ := PByte(P1)^;
-
 
2987
                PByte(P1)^ := PByte(P2)^;
-
 
2988
                PByte(P2)^ := PByte(@c)^;
-
 
2989
                Inc(PByte(P1));
-
 
2990
                Dec(PByte(P2));
-
 
2991
              end;
-
 
2992
            end;
-
 
2993
          16:
-
 
2994
            begin
-
 
2995
              P2 := Pointer(Integer(P1) + (Width - 1) * 2);
-
 
2996
              for x := 0 to Width2 - 1 do
-
 
2997
              begin
-
 
2998
                PWord(@c)^ := PWord(P1)^;
-
 
2999
                PWord(P1)^ := PWord(P2)^;
-
 
3000
                PWord(P2)^ := PWord(@c)^;
-
 
3001
                Inc(PWord(P1));
-
 
3002
                Dec(PWord(P2));
-
 
3003
              end;
-
 
3004
            end;
-
 
3005
          24:
-
 
3006
            begin
-
 
3007
              P2 := Pointer(Integer(P1) + (Width - 1) * 3);
-
 
3008
              for x := 0 to Width2 - 1 do
-
 
3009
              begin
-
 
3010
                PBGR(@c)^ := PBGR(P1)^;
-
 
3011
                PBGR(P1)^ := PBGR(P2)^;
-
 
3012
                PBGR(P2)^ := PBGR(@c)^;
-
 
3013
                Inc(PBGR(P1));
-
 
3014
                Dec(PBGR(P2));
-
 
3015
              end;
-
 
3016
            end;
-
 
3017
          32:
-
 
3018
            begin
-
 
3019
              P2 := Pointer(Integer(P1) + (Width - 1) * 4);
-
 
3020
              for x := 0 to Width2 - 1 do
-
 
3021
              begin
-
 
3022
                PDWORD(@c)^ := PDWORD(P1)^;
-
 
3023
                PDWORD(P1)^ := PDWORD(P2)^;
-
 
3024
                PDWORD(P2)^ := PDWORD(@c)^;
-
 
3025
                Inc(PDWORD(P1));
-
 
3026
                Dec(PDWORD(P2));
-
 
3027
              end;
-
 
3028
            end;
-
 
3029
        end;
-
 
3030
 
-
 
3031
        UpdateProgress(y);
-
 
3032
      end;
-
 
3033
    finally
-
 
3034
      EndProgress;
-
 
3035
    end;
-
 
3036
  end
-
 
3037
  else
-
 
3038
  if (MirrorX) and (MirrorY) then
-
 
3039
  begin
-
 
3040
    StartProgress('Mirror');
-
 
3041
    try
-
 
3042
      for y := 0 to Height shr 1 - 1 do
-
 
3043
      begin
-
 
3044
        P1 := ScanLine[y];
-
 
3045
        P2 := ScanLine[Height - y - 1];
-
 
3046
 
-
 
3047
        case BitCount of
-
 
3048
          1:
-
 
3049
            begin
-
 
3050
              for x := 0 to Width - 1 do
-
 
3051
              begin
-
 
3052
                c := Pixels[x, y];
-
 
3053
                Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1];
-
 
3054
                Pixels[Width - x - 1, Height - y - 1] := c;
-
 
3055
              end;
-
 
3056
            end;
-
 
3057
          4:
-
 
3058
            begin
-
 
3059
              for x := 0 to Width - 1 do
-
 
3060
              begin
-
 
3061
                c := Pixels[x, y];
-
 
3062
                Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1];
-
 
3063
                Pixels[Width - x - 1, Height - y - 1] := c;
-
 
3064
              end;
-
 
3065
            end;
-
 
3066
          8:
-
 
3067
            begin
-
 
3068
              P2 := Pointer(Integer(P2) + Width - 1);
-
 
3069
              for x := 0 to Width - 1 do
-
 
3070
              begin
-
 
3071
                PByte(@c)^ := PByte(P1)^;
-
 
3072
                PByte(P1)^ := PByte(P2)^;
-
 
3073
                PByte(P2)^ := PByte(@c)^;
-
 
3074
                Inc(PByte(P1));
-
 
3075
                Dec(PByte(P2));
-
 
3076
              end;
-
 
3077
            end;
-
 
3078
          16:
-
 
3079
            begin
-
 
3080
              P2 := Pointer(Integer(P2) + (Width - 1) * 2);
-
 
3081
              for x := 0 to Width - 1 do
-
 
3082
              begin
-
 
3083
                PWord(@c)^ := PWord(P1)^;
-
 
3084
                PWord(P1)^ := PWord(P2)^;
-
 
3085
                PWord(P2)^ := PWord(@c)^;
-
 
3086
                Inc(PWord(P1));
-
 
3087
                Dec(PWord(P2));
-
 
3088
              end;
-
 
3089
            end;
-
 
3090
          24:
-
 
3091
            begin
-
 
3092
              P2 := Pointer(Integer(P2) + (Width - 1) * 3);
-
 
3093
              for x := 0 to Width - 1 do
-
 
3094
              begin
-
 
3095
                PBGR(@c)^ := PBGR(P1)^;
-
 
3096
                PBGR(P1)^ := PBGR(P2)^;
-
 
3097
                PBGR(P2)^ := PBGR(@c)^;
-
 
3098
                Inc(PBGR(P1));
-
 
3099
                Dec(PBGR(P2));
-
 
3100
              end;
-
 
3101
            end;
-
 
3102
          32:
-
 
3103
            begin
-
 
3104
              P2 := Pointer(Integer(P2) + (Width - 1) * 4);
-
 
3105
              for x := 0 to Width - 1 do
-
 
3106
              begin
-
 
3107
                PDWORD(@c)^ := PDWORD(P1)^;
-
 
3108
                PDWORD(P1)^ := PDWORD(P2)^;
-
 
3109
                PDWORD(P2)^ := PDWORD(@c)^;
-
 
3110
                Inc(PDWORD(P1));
-
 
3111
                Dec(PDWORD(P2));
-
 
3112
              end;
-
 
3113
            end;
-
 
3114
        end;
-
 
3115
 
-
 
3116
        UpdateProgress(y * 2);
-
 
3117
      end;
-
 
3118
    finally
-
 
3119
      EndProgress;
-
 
3120
    end;
-
 
3121
  end;
-
 
3122
end;
-
 
3123
 
2254
procedure TDIB.Blur(ABitCount: Integer; Radius: Integer);
3124
procedure TDIB.Blur(ABitCount: Integer; Radius: Integer);
2255
type
3125
type
2256
  TAve = record
3126
  TAve = record
2257
    cR, cG, cB: DWORD;
3127
    cR, cG, cB: DWORD;
2258
    c: DWORD;
3128
    c: DWORD;
Line 2268... Line 3138...
2268
    SrcP: Pointer;
3138
    SrcP: Pointer;
2269
    AveP: ^TAve;
3139
    AveP: ^TAve;
2270
    R, G, B: Byte;
3140
    R, G, B: Byte;
2271
  begin
3141
  begin
2272
    case Temp.BitCount of
3142
    case Temp.BitCount of
-
 
3143
      1:
2273
      1 : begin
3144
        begin
2274
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
3145
          SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
2275
            AveP := @Ave;
3146
          AveP := @Ave;
2276
            for x:=0 to XCount-1 do
3147
          for x := 0 to XCount - 1 do
2277
            begin
3148
          begin
2278
              with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do
3149
            with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do
Line 2283... Line 3154...
2283
                Inc(c);
3154
              Inc(c);
2284
              end;
3155
            end;
2285
              Inc(AveP);
3156
            Inc(AveP);
2286
            end;
3157
          end;
2287
          end;
3158
        end;
-
 
3159
      4:
2288
      4 : begin
3160
        begin
2289
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
3161
          SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
2290
            AveP := @Ave;
3162
          AveP := @Ave;
2291
            for x:=0 to XCount-1 do
3163
          for x := 0 to XCount - 1 do
2292
            begin
3164
          begin
2293
              with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do
3165
            with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do
Line 2298... Line 3170...
2298
                Inc(c);
3170
              Inc(c);
2299
              end;
3171
            end;
2300
              Inc(AveP);
3172
            Inc(AveP);
2301
            end;
3173
          end;
2302
          end;
3174
        end;
-
 
3175
      8:
2303
      8 : begin
3176
        begin
2304
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
3177
          SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
2305
            AveP := @Ave;
3178
          AveP := @Ave;
2306
            for x:=0 to XCount-1 do
3179
          for x := 0 to XCount - 1 do
2307
            begin
3180
          begin
2308
              with Temp.ColorTable[PByte(SrcP)^], AveP^ do
3181
            with Temp.ColorTable[PByte(SrcP)^], AveP^ do
Line 2314... Line 3187...
2314
              end;
3187
            end;
2315
              Inc(PByte(SrcP));
3188
            Inc(PByte(SrcP));
2316
              Inc(AveP);
3189
            Inc(AveP);
2317
            end;
3190
          end;
2318
          end;
3191
        end;
-
 
3192
      16:
2319
      16: begin
3193
        begin
2320
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
3194
          SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
2321
            AveP := @Ave;
3195
          AveP := @Ave;
2322
            for x:=0 to XCount-1 do
3196
          for x := 0 to XCount - 1 do
2323
            begin
3197
          begin
2324
              pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
3198
            pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
Line 2331... Line 3205...
2331
              end;
3205
            end;
2332
              Inc(PWord(SrcP));
3206
            Inc(PWord(SrcP));
2333
              Inc(AveP);
3207
            Inc(AveP);
2334
            end;
3208
          end;
2335
          end;
3209
        end;
-
 
3210
      24:
2336
      24: begin
3211
        begin
2337
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
3212
          SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
2338
            AveP := @Ave;
3213
          AveP := @Ave;
2339
            for x:=0 to XCount-1 do
3214
          for x := 0 to XCount - 1 do
2340
            begin
3215
          begin
2341
              with PBGR(SrcP)^, AveP^ do
3216
            with PBGR(SrcP)^, AveP^ do
Line 2347... Line 3222...
2347
              end;
3222
            end;
2348
              Inc(PBGR(SrcP));
3223
            Inc(PBGR(SrcP));
2349
              Inc(AveP);
3224
            Inc(AveP);
2350
            end;
3225
          end;
2351
          end;
3226
        end;
-
 
3227
      32:
2352
      32: begin
3228
        begin
2353
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
3229
          SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
2354
            AveP := @Ave;
3230
          AveP := @Ave;
2355
            for x:=0 to XCount-1 do
3231
          for x := 0 to XCount - 1 do
2356
            begin
3232
          begin
2357
              pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
3233
            pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
Line 2375... Line 3251...
2375
    SrcP: Pointer;
3251
    SrcP: Pointer;
2376
    AveP: ^TAve;
3252
    AveP: ^TAve;
2377
    R, G, B: Byte;
3253
    R, G, B: Byte;
2378
  begin
3254
  begin
2379
    case Temp.BitCount of
3255
    case Temp.BitCount of
-