Rev 4 | Go to most recent revision | Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
1 | daniel-mar | 1 | unit DIB; |
2 | |||
3 | interface |
||
4 | |||
5 | {$INCLUDE DelphiXcfg.inc} |
||
6 | |||
7 | uses |
||
8 | Windows, SysUtils, Classes, Graphics, Controls; |
||
9 | |||
10 | type |
||
11 | TRGBQuads = array[0..255] of TRGBQuad; |
||
12 | |||
13 | TPaletteEntries = array[0..255] of TPaletteEntry; |
||
14 | |||
15 | PBGR = ^TBGR; |
||
16 | TBGR = packed record |
||
17 | B, G, R: Byte; |
||
18 | end; |
||
19 | |||
20 | PArrayBGR = ^TArrayBGR; |
||
21 | TArrayBGR = array[0..10000] of TBGR; |
||
22 | |||
23 | PArrayByte = ^TArrayByte; |
||
24 | TArrayByte = array[0..10000] of Byte; |
||
25 | |||
26 | PArrayWord = ^TArrayWord; |
||
27 | TArrayWord = array[0..10000] of Word; |
||
28 | |||
29 | PArrayDWord = ^TArrayDWord; |
||
30 | TArrayDWord = array[0..10000] of DWord; |
||
31 | |||
32 | { TDIB } |
||
33 | |||
34 | TDIBPixelFormat = record |
||
35 | RBitMask, GBitMask, BBitMask: DWORD; |
||
36 | RBitCount, GBitCount, BBitCount: DWORD; |
||
37 | RShift, GShift, BShift: DWORD; |
||
38 | RBitCount2, GBitCount2, BBitCount2: DWORD; |
||
39 | end; |
||
40 | |||
41 | TDIBSharedImage = class(TSharedImage) |
||
42 | private |
||
43 | FBitCount: Integer; |
||
44 | FBitmapInfo: PBitmapInfo; |
||
45 | FBitmapInfoSize: Integer; |
||
46 | FChangePalette: Boolean; |
||
47 | FColorTable: TRGBQuads; |
||
48 | FColorTablePos: Integer; |
||
49 | FCompressed: Boolean; |
||
50 | FDC: THandle; |
||
51 | FHandle: THandle; |
||
52 | FHeight: Integer; |
||
53 | FMemoryImage: Boolean; |
||
54 | FNextLine: Integer; |
||
55 | FOldHandle: THandle; |
||
56 | FPalette: HPalette; |
||
57 | FPaletteCount: Integer; |
||
58 | FPBits: Pointer; |
||
59 | FPixelFormat: TDIBPixelFormat; |
||
60 | FSize: Integer; |
||
61 | FTopPBits: Pointer; |
||
62 | FWidth: Integer; |
||
63 | FWidthBytes: Integer; |
||
64 | constructor Create; |
||
65 | procedure NewImage(AWidth, AHeight, ABitCount: Integer; |
||
66 | const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean); |
||
67 | procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); |
||
68 | procedure Compress(Source: TDIBSharedImage); |
||
69 | procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean); |
||
70 | procedure ReadData(Stream: TStream; MemoryImage: Boolean); |
||
71 | function GetPalette: THandle; |
||
72 | procedure SetColorTable(const Value: TRGBQuads); |
||
73 | protected |
||
74 | procedure FreeHandle; override; |
||
75 | public |
||
76 | destructor Destroy; override; |
||
77 | end; |
||
78 | |||
79 | TDIB = class(TGraphic) |
||
80 | private |
||
81 | FCanvas: TCanvas; |
||
82 | FImage: TDIBSharedImage; |
||
83 | |||
84 | FProgressName: string; |
||
85 | FProgressOldY: DWORD; |
||
86 | FProgressOldTime: DWORD; |
||
87 | FProgressOld: DWORD; |
||
88 | FProgressY: DWORD; |
||
89 | { For speed-up } |
||
90 | FBitCount: Integer; |
||
91 | FHeight: Integer; |
||
92 | FNextLine: Integer; |
||
93 | FNowPixelFormat: TDIBPixelFormat; |
||
94 | FPBits: Pointer; |
||
95 | FSize: Integer; |
||
96 | FTopPBits: Pointer; |
||
97 | FWidth: Integer; |
||
98 | FWidthBytes: Integer; |
||
99 | procedure AllocHandle; |
||
100 | procedure CanvasChanging(Sender: TObject); |
||
101 | procedure Changing(MemoryImage: Boolean); |
||
102 | procedure ConvertBitCount(ABitCount: Integer); |
||
103 | function GetBitmapInfo: PBitmapInfo; |
||
104 | function GetBitmapInfoSize: Integer; |
||
105 | function GetCanvas: TCanvas; |
||
106 | function GetHandle: THandle; |
||
107 | function GetPaletteCount: Integer; |
||
108 | function GetPixel(X, Y: Integer): DWORD; |
||
109 | function GetPBits: Pointer; |
||
110 | function GetPBitsReadOnly: Pointer; |
||
111 | function GetScanLine(Y: Integer): Pointer; |
||
112 | function GetScanLineReadOnly(Y: Integer): Pointer; |
||
113 | function GetTopPBits: Pointer; |
||
114 | function GetTopPBitsReadOnly: Pointer; |
||
115 | procedure SetBitCount(Value: Integer); |
||
116 | procedure SetImage(Value: TDIBSharedImage); |
||
117 | procedure SetNowPixelFormat(const Value: TDIBPixelFormat); |
||
118 | procedure SetPixel(X, Y: Integer; Value: DWORD); |
||
119 | procedure StartProgress(const Name: string); |
||
120 | procedure EndProgress; |
||
121 | procedure UpdateProgress(PercentY: Integer); |
||
122 | protected |
||
123 | procedure DefineProperties(Filer: TFiler); override; |
||
124 | procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; |
||
125 | function GetEmpty: Boolean; override; |
||
126 | function GetHeight: Integer; override; |
||
127 | function GetPalette: HPalette; override; |
||
128 | function GetWidth: Integer; override; |
||
129 | procedure ReadData(Stream: TStream); override; |
||
130 | procedure SetHeight(Value: Integer); override; |
||
131 | procedure SetPalette(Value: HPalette); override; |
||
132 | procedure SetWidth(Value: Integer); override; |
||
133 | procedure WriteData(Stream: TStream); override; |
||
134 | public |
||
135 | ColorTable: TRGBQuads; |
||
136 | PixelFormat: TDIBPixelFormat; |
||
137 | constructor Create; override; |
||
138 | destructor Destroy; override; |
||
139 | procedure Assign(Source: TPersistent); override; |
||
140 | procedure Clear; |
||
141 | procedure Compress; |
||
142 | procedure Decompress; |
||
143 | procedure FreeHandle; |
||
144 | procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; |
||
145 | APalette: HPALETTE); override; |
||
146 | procedure LoadFromStream(Stream: TStream); override; |
||
147 | procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; |
||
148 | var APalette: HPALETTE); override; |
||
149 | procedure SaveToStream(Stream: TStream); override; |
||
150 | procedure SetSize(AWidth, AHeight, ABitCount: Integer); |
||
151 | procedure UpdatePalette; |
||
152 | { Special effect } |
||
153 | procedure Blur(ABitCount: Integer; Radius: Integer); |
||
154 | procedure Greyscale(ABitCount: Integer); |
||
155 | procedure Mirror(MirrorX, MirrorY: Boolean); |
||
156 | procedure Negative; |
||
157 | |||
158 | property BitCount: Integer read FBitCount write SetBitCount; |
||
159 | property BitmapInfo: PBitmapInfo read GetBitmapInfo; |
||
160 | property BitmapInfoSize: Integer read GetBitmapInfoSize; |
||
161 | property Canvas: TCanvas read GetCanvas; |
||
162 | property Handle: THandle read GetHandle; |
||
163 | property Height: Integer read FHeight write SetHeight; |
||
164 | property NextLine: Integer read FNextLine; |
||
165 | property NowPixelFormat: TDIBPixelFormat read FNowPixelFormat write SetNowPixelFormat; |
||
166 | property PaletteCount: Integer read GetPaletteCount; |
||
167 | property PBits: Pointer read GetPBits; |
||
168 | property PBitsReadOnly: Pointer read GetPBitsReadOnly; |
||
169 | property Pixels[X, Y: Integer]: DWORD read GetPixel write SetPixel; |
||
170 | property ScanLine[Y: Integer]: Pointer read GetScanLine; |
||
171 | property ScanLineReadOnly[Y: Integer]: Pointer read GetScanLineReadOnly; |
||
172 | property Size: Integer read FSize; |
||
173 | property TopPBits: Pointer read GetTopPBits; |
||
174 | property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly; |
||
175 | property Width: Integer read FWidth write SetWidth; |
||
176 | property WidthBytes: Integer read FWidthBytes; |
||
177 | end; |
||
178 | |||
179 | TDIBitmap = class(TDIB) end; |
||
180 | |||
181 | { TCustomDXDIB } |
||
182 | |||
183 | TCustomDXDIB = class(TComponent) |
||
184 | private |
||
185 | FDIB: TDIB; |
||
186 | procedure SetDIB(Value: TDIB); |
||
187 | public |
||
188 | constructor Create(AOnwer: TComponent); override; |
||
189 | destructor Destroy; override; |
||
190 | property DIB: TDIB read FDIB write SetDIB; |
||
191 | end; |
||
192 | |||
193 | { TDXDIB } |
||
194 | |||
195 | TDXDIB = class(TCustomDXDIB) |
||
196 | published |
||
197 | property DIB; |
||
198 | end; |
||
199 | |||
200 | { TCustomDXPaintBox } |
||
201 | |||
202 | TCustomDXPaintBox = class(TGraphicControl) |
||
203 | private |
||
204 | FAutoStretch: Boolean; |
||
205 | FCenter: Boolean; |
||
206 | FDIB: TDIB; |
||
207 | FKeepAspect: Boolean; |
||
208 | FStretch: Boolean; |
||
209 | FViewWidth: Integer; |
||
210 | FViewHeight: Integer; |
||
211 | procedure SetAutoStretch(Value: Boolean); |
||
212 | procedure SetCenter(Value: Boolean); |
||
213 | procedure SetDIB(Value: TDIB); |
||
214 | procedure SetKeepAspect(Value: Boolean); |
||
215 | procedure SetStretch(Value: Boolean); |
||
216 | procedure SetViewWidth(Value: Integer); |
||
217 | procedure SetViewHeight(Value: Integer); |
||
218 | protected |
||
219 | function GetPalette: HPALETTE; override; |
||
220 | public |
||
221 | constructor Create(AOwner: TComponent); override; |
||
222 | destructor Destroy; override; |
||
223 | procedure Paint; override; |
||
224 | property AutoStretch: Boolean read FAutoStretch write SetAutoStretch; |
||
225 | property Canvas; |
||
226 | property Center: Boolean read FCenter write SetCenter; |
||
227 | property DIB: TDIB read FDIB write SetDIB; |
||
228 | property KeepAspect: Boolean read FKeepAspect write SetKeepAspect; |
||
229 | property Stretch: Boolean read FStretch write SetStretch; |
||
230 | property ViewWidth: Integer read FViewWidth write SetViewWidth; |
||
231 | property ViewHeight: Integer read FViewHeight write SetViewHeight; |
||
232 | end; |
||
233 | |||
234 | { TDXPaintBox } |
||
235 | |||
236 | TDXPaintBox = class(TCustomDXPaintBox) |
||
237 | published |
||
238 | {$IFDEF DelphiX_Spt4}property Anchors;{$ENDIF} |
||
239 | property AutoStretch; |
||
240 | property Center; |
||
241 | {$IFDEF DelphiX_Spt4}property Constraints;{$ENDIF} |
||
242 | property DIB; |
||
243 | property KeepAspect; |
||
244 | property Stretch; |
||
245 | property ViewWidth; |
||
246 | property ViewHeight; |
||
247 | |||
248 | property Align; |
||
249 | property DragCursor; |
||
250 | property DragMode; |
||
251 | property Enabled; |
||
252 | property ParentShowHint; |
||
253 | property PopupMenu; |
||
254 | property ShowHint; |
||
255 | property Visible; |
||
256 | property OnClick; |
||
257 | property OnDblClick; |
||
258 | property OnDragDrop; |
||
259 | property OnDragOver; |
||
260 | property OnEndDrag; |
||
261 | property OnMouseDown; |
||
262 | property OnMouseMove; |
||
263 | property OnMouseUp; |
||
264 | property OnStartDrag; |
||
265 | end; |
||
266 | |||
267 | function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; |
||
268 | function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; |
||
269 | function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; |
||
270 | procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); |
||
271 | function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
||
272 | function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
||
273 | function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
||
274 | |||
275 | function GreyscaleColorTable: TRGBQuads; |
||
276 | |||
277 | function RGBQuad(R, G, B: Byte): TRGBQuad; |
||
278 | function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; |
||
279 | function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; |
||
280 | function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; |
||
281 | function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; |
||
282 | |||
283 | implementation |
||
284 | |||
285 | uses DXConsts; |
||
286 | |||
287 | function Max(B1, B2: Integer): Integer; |
||
288 | begin |
||
289 | if B1>=B2 then Result := B1 else Result := B2; |
||
290 | end; |
||
291 | |||
292 | function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; |
||
293 | begin |
||
294 | Result.RBitMask := ((1 shl RBitCount)-1) shl (GBitCount+BBitCount); |
||
295 | Result.GBitMask := ((1 shl GBitCount)-1) shl (BBitCount); |
||
296 | Result.BBitMask := (1 shl BBitCount)-1; |
||
297 | Result.RBitCount := RBitCount; |
||
298 | Result.GBitCount := GBitCount; |
||
299 | Result.BBitCount := BBitCount; |
||
300 | Result.RBitCount2 := 8-RBitCount; |
||
301 | Result.GBitCount2 := 8-GBitCount; |
||
302 | Result.BBitCount2 := 8-BBitCount; |
||
303 | Result.RShift := (GBitCount+BBitCount)-(8-RBitCount); |
||
304 | Result.GShift := BBitCount-(8-GBitCount); |
||
305 | Result.BShift := 8-BBitCount; |
||
306 | end; |
||
307 | |||
308 | function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; |
||
309 | |||
310 | function GetBitCount(b: Integer): Integer; |
||
311 | var |
||
312 | i: Integer; |
||
313 | begin |
||
314 | i := 0; |
||
315 | while (i<31) and (((1 shl i) and b)=0) do Inc(i); |
||
316 | |||
317 | Result := 0; |
||
318 | while ((1 shl i) and b)<>0 do |
||
319 | begin |
||
320 | Inc(i); |
||
321 | Inc(Result); |
||
322 | end; |
||
323 | end; |
||
324 | |||
325 | begin |
||
326 | Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask), |
||
327 | GetBitCount(BBitMask)); |
||
328 | end; |
||
329 | |||
330 | function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; |
||
331 | begin |
||
332 | with PixelFormat do |
||
333 | Result := ((R shl RShift) and RBitMask) or ((G shl GShift) and GBitMask) or |
||
334 | ((B shr BShift) and BBitMask); |
||
335 | end; |
||
336 | |||
337 | procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); |
||
338 | begin |
||
339 | with PixelFormat do |
||
340 | begin |
||
341 | R := (Color and RBitMask) shr RShift; |
||
342 | R := R or (R shr RBitCount2); |
||
343 | G := (Color and GBitMask) shr GShift; |
||
344 | G := G or (G shr GBitCount2); |
||
345 | B := (Color and BBitMask) shl BShift; |
||
346 | B := B or (B shr BBitCount2); |
||
347 | end; |
||
348 | end; |
||
349 | |||
350 | function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
||
351 | begin |
||
352 | with PixelFormat do |
||
353 | begin |
||
354 | Result := (Color and RBitMask) shr RShift; |
||
355 | Result := Result or (Result shr RBitCount); |
||
356 | end; |
||
357 | end; |
||
358 | |||
359 | function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
||
360 | begin |
||
361 | with PixelFormat do |
||
362 | begin |
||
363 | Result := (Color and GBitMask) shr GShift; |
||
364 | Result := Result or (Result shr GBitCount); |
||
365 | end; |
||
366 | end; |
||
367 | |||
368 | function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
||
369 | begin |
||
370 | with PixelFormat do |
||
371 | begin |
||
372 | Result := (Color and BBitMask) shl BShift; |
||
373 | Result := Result or (Result shr BBitCount); |
||
374 | end; |
||
375 | end; |
||
376 | |||
377 | function GreyscaleColorTable: TRGBQuads; |
||
378 | var |
||
379 | i: Integer; |
||
380 | begin |
||
381 | for i:=0 to 255 do |
||
382 | with Result[i] do |
||
383 | begin |
||
384 | rgbRed := i; |
||
385 | rgbGreen := i; |
||
386 | rgbBlue := i; |
||
387 | rgbReserved := 0; |
||
388 | end; |
||
389 | end; |
||
390 | |||
391 | function RGBQuad(R, G, B: Byte): TRGBQuad; |
||
392 | begin |
||
393 | with Result do |
||
394 | begin |
||
395 | rgbRed := R; |
||
396 | rgbGreen := G; |
||
397 | rgbBlue := B; |
||
398 | rgbReserved := 0; |
||
399 | end; |
||
400 | end; |
||
401 | |||
402 | function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; |
||
403 | begin |
||
404 | with Result do |
||
405 | with Entry do |
||
406 | begin |
||
407 | rgbRed := peRed; |
||
408 | rgbGreen := peGreen; |
||
409 | rgbBlue := peBlue; |
||
410 | rgbReserved := 0; |
||
411 | end; |
||
412 | end; |
||
413 | |||
414 | function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; |
||
415 | var |
||
416 | i: Integer; |
||
417 | begin |
||
418 | for i:=0 to 255 do |
||
419 | Result[i] := PaletteEntryToRGBQuad(Entries[i]); |
||
420 | end; |
||
421 | |||
422 | function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; |
||
423 | begin |
||
424 | with Result do |
||
425 | with RGBQuad do |
||
426 | begin |
||
427 | peRed := rgbRed; |
||
428 | peGreen := rgbGreen; |
||
429 | peBlue := rgbBlue; |
||
430 | peFlags := 0; |
||
431 | end; |
||
432 | end; |
||
433 | |||
434 | function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; |
||
435 | var |
||
436 | i: Integer; |
||
437 | begin |
||
438 | for i:=0 to 255 do |
||
439 | Result[i] := RGBQuadToPaletteEntry(RGBQuads[i]); |
||
440 | end; |
||
441 | |||
442 | { TDIBSharedImage } |
||
443 | |||
444 | type |
||
445 | PLocalDIBPixelFormat = ^TLocalDIBPixelFormat; |
||
446 | TLocalDIBPixelFormat = packed record |
||
447 | RBitMask, GBitMask, BBitMask: DWORD; |
||
448 | end; |
||
449 | |||
450 | TPaletteItem = class(TCollectionItem) |
||
451 | private |
||
452 | ID: Integer; |
||
453 | Palette: HPalette; |
||
454 | RefCount: Integer; |
||
455 | ColorTable: TRGBQuads; |
||
456 | ColorTableCount: Integer; |
||
457 | destructor Destroy; override; |
||
458 | procedure AddRef; |
||
459 | procedure Release; |
||
460 | end; |
||
461 | |||
462 | TPaletteManager = class |
||
463 | private |
||
464 | FList: TCollection; |
||
465 | constructor Create; |
||
466 | destructor Destroy; override; |
||
467 | function CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette; |
||
468 | procedure DeletePalette(var Palette: HPalette); |
||
469 | end; |
||
470 | |||
471 | destructor TPaletteItem.Destroy; |
||
472 | begin |
||
473 | DeleteObject(Palette); |
||
474 | inherited Destroy; |
||
475 | end; |
||
476 | |||
477 | procedure TPaletteItem.AddRef; |
||
478 | begin |
||
479 | Inc(RefCount); |
||
480 | end; |
||
481 | |||
482 | procedure TPaletteItem.Release; |
||
483 | begin |
||
484 | Dec(RefCount); |
||
485 | if RefCount<=0 then Free; |
||
486 | end; |
||
487 | |||
488 | constructor TPaletteManager.Create; |
||
489 | begin |
||
490 | inherited Create; |
||
491 | FList := TCollection.Create(TPaletteItem); |
||
492 | end; |
||
493 | |||
494 | destructor TPaletteManager.Destroy; |
||
495 | begin |
||
496 | FList.Free; |
||
497 | inherited Destroy; |
||
498 | end; |
||
499 | |||
500 | function TPaletteManager.CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette; |
||
501 | type |
||
502 | TMyLogPalette = record |
||
503 | palVersion: Word; |
||
504 | palNumEntries: Word; |
||
505 | palPalEntry: TPaletteEntries; |
||
506 | end; |
||
507 | var |
||
508 | i, ID: Integer; |
||
509 | Item: TPaletteItem; |
||
510 | LogPalette: TMyLogPalette; |
||
511 | begin |
||
512 | { Hash key making } |
||
513 | ID := ColorTableCount; |
||
514 | for i:=0 to ColorTableCount-1 do |
||
515 | with ColorTable[i] do |
||
516 | begin |
||
517 | Inc(ID, rgbRed); |
||
518 | Inc(ID, rgbGreen); |
||
519 | Inc(ID, rgbBlue); |
||
520 | end; |
||
521 | |||
522 | { Does the same palette already exist? } |
||
523 | for i:=0 to FList.Count-1 do |
||
524 | begin |
||
525 | Item := TPaletteItem(FList.Items[i]); |
||
526 | if (Item.ID=ID) and (Item.ColorTableCount=ColorTableCount) and |
||
527 | CompareMem(@Item.ColorTable, @ColorTable, ColorTableCount*SizeOf(TRGBQuad)) then |
||
528 | begin |
||
529 | Item.AddRef; Result := Item.Palette; |
||
530 | Exit; |
||
531 | end; |
||
532 | end; |
||
533 | |||
534 | { New palette making } |
||
535 | Item := TPaletteItem.Create(FList); |
||
536 | Item.ID := ID; |
||
537 | Move(ColorTable, Item.ColorTable, ColorTableCount*SizeOf(TRGBQuad)); |
||
538 | Item.ColorTableCount := ColorTableCount; |
||
539 | |||
540 | with LogPalette do |
||
541 | begin |
||
542 | palVersion := $300; |
||
543 | palNumEntries := ColorTableCount; |
||
544 | palPalEntry := RGBQuadsToPaletteEntries(ColorTable); |
||
545 | end; |
||
546 | |||
547 | Item.Palette := Windows.CreatePalette(PLogPalette(@LogPalette)^); |
||
548 | Item.AddRef; Result := Item.Palette; |
||
549 | end; |
||
550 | |||
551 | procedure TPaletteManager.DeletePalette(var Palette: HPalette); |
||
552 | var |
||
553 | i: Integer; |
||
554 | Item: TPaletteItem; |
||
555 | begin |
||
556 | if Palette=0 then Exit; |
||
557 | |||
558 | for i:=0 to FList.Count-1 do |
||
559 | begin |
||
560 | Item := TPaletteItem(FList.Items[i]); |
||
561 | if (Item.Palette=Palette) then |
||
562 | begin |
||
563 | Palette := 0; |
||
564 | Item.Release; |
||
565 | Exit; |
||
566 | end; |
||
567 | end; |
||
568 | end; |
||
569 | |||
570 | var |
||
571 | FPaletteManager: TPaletteManager; |
||
572 | |||
573 | function PaletteManager: TPaletteManager; |
||
574 | begin |
||
575 | if FPaletteManager=nil then |
||
576 | FPaletteManager := TPaletteManager.Create; |
||
577 | Result := FPaletteManager; |
||
578 | end; |
||
579 | |||
580 | constructor TDIBSharedImage.Create; |
||
581 | begin |
||
582 | inherited Create; |
||
583 | FMemoryImage := True; |
||
584 | SetColorTable(GreyscaleColorTable); |
||
585 | FColorTable := GreyscaleColorTable; |
||
586 | FPixelFormat := MakeDIBPixelFormat(8, 8, 8); |
||
587 | end; |
||
588 | |||
589 | procedure TDIBSharedImage.NewImage(AWidth, AHeight, ABitCount: Integer; |
||
590 | const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean); |
||
591 | var |
||
592 | InfoOfs: Integer; |
||
593 | UsePixelFormat: Boolean; |
||
594 | begin |
||
595 | Create; |
||
596 | |||
597 | { Pixel format check } |
||
598 | case ABitCount of |
||
599 | 1 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
||
600 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
601 | 4 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
||
602 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
603 | 8 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
||
604 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
605 | 16: begin |
||
606 | 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 |
||
608 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
609 | end; |
||
610 | 24: begin |
||
611 | if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
||
612 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
613 | end; |
||
614 | 32: begin |
||
615 | if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
||
616 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
617 | end; |
||
618 | else |
||
619 | raise EInvalidGraphicOperation.CreateFmt(SInvalidDIBBitCount, [ABitCount]); |
||
620 | end; |
||
621 | |||
622 | FBitCount := ABitCount; |
||
623 | FHeight := AHeight; |
||
624 | FWidth := AWidth; |
||
625 | FWidthBytes := (((AWidth*ABitCount)+31) shr 5) * 4; |
||
626 | FNextLine := -FWidthBytes; |
||
627 | FSize := FWidthBytes*FHeight; |
||
628 | UsePixelFormat := ABitCount in [16, 32]; |
||
629 | |||
630 | FPixelFormat := PixelFormat; |
||
631 | |||
632 | FPaletteCount := 0; |
||
633 | if FBitCount<=8 then |
||
634 | FPaletteCount := 1 shl FBitCount; |
||
635 | |||
636 | FBitmapInfoSize := SizeOf(TBitmapInfoHeader); |
||
637 | if UsePixelFormat then |
||
638 | Inc(FBitmapInfoSize, SizeOf(TLocalDIBPixelFormat)); |
||
639 | Inc(FBitmapInfoSize, SizeOf(TRGBQuad)*FPaletteCount); |
||
640 | |||
641 | GetMem(FBitmapInfo, FBitmapInfoSize); |
||
642 | FillChar(FBitmapInfo^, FBitmapInfoSize, 0); |
||
643 | |||
644 | { BitmapInfo setting. } |
||
645 | with FBitmapInfo^.bmiHeader do |
||
646 | begin |
||
647 | biSize := SizeOf(TBitmapInfoHeader); |
||
648 | biWidth := FWidth; |
||
649 | biHeight := FHeight; |
||
650 | biPlanes := 1; |
||
651 | biBitCount := FBitCount; |
||
652 | if UsePixelFormat then |
||
653 | biCompression := BI_BITFIELDS |
||
654 | else |
||
655 | begin |
||
656 | if (FBitCount=4) and (Compressed) then |
||
657 | biCompression := BI_RLE4 |
||
658 | else if (FBitCount=8) and (Compressed) then |
||
659 | biCompression := BI_RLE8 |
||
660 | else |
||
661 | biCompression := BI_RGB; |
||
662 | end; |
||
663 | biSizeImage := FSize; |
||
664 | biXPelsPerMeter := 0; |
||
665 | biYPelsPerMeter := 0; |
||
666 | biClrUsed := 0; |
||
667 | biClrImportant := 0; |
||
668 | end; |
||
669 | InfoOfs := SizeOf(TBitmapInfoHeader); |
||
670 | |||
671 | if UsePixelFormat then |
||
672 | begin |
||
673 | with PLocalDIBPixelFormat(Integer(FBitmapInfo)+InfoOfs)^ do |
||
674 | begin |
||
675 | RBitMask := PixelFormat.RBitMask; |
||
676 | GBitMask := PixelFormat.GBitMask; |
||
677 | BBitMask := PixelFormat.BBitMask; |
||
678 | end; |
||
679 | |||
680 | Inc(InfoOfs, SizeOf(TLocalDIBPixelFormat)); |
||
681 | end; |
||
682 | |||
683 | FColorTablePos := InfoOfs; |
||
684 | |||
685 | FColorTable := ColorTable; |
||
686 | Move(FColorTable, Pointer(Integer(FBitmapInfo)+FColorTablePos)^, SizeOf(TRGBQuad)*FPaletteCount); |
||
687 | |||
688 | FCompressed := FBitmapInfo^.bmiHeader.biCompression in [BI_RLE4, BI_RLE8]; |
||
689 | FMemoryImage := MemoryImage or FCompressed; |
||
690 | |||
691 | { DIB making. } |
||
692 | if not Compressed then |
||
693 | begin |
||
694 | if MemoryImage then |
||
695 | begin |
||
696 | FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize)); |
||
697 | if FPBits=nil then |
||
698 | OutOfMemoryError; |
||
699 | end else |
||
700 | begin |
||
701 | FDC := CreateCompatibleDC(0); |
||
702 | |||
703 | FHandle := CreateDIBSection(FDC, FBitmapInfo^, DIB_RGB_COLORS, FPBits, 0, 0); |
||
704 | if FHandle=0 then |
||
705 | raise EOutOfResources.CreateFmt(SCannotMade, ['DIB']); |
||
706 | |||
707 | FOldHandle := SelectObject(FDC, FHandle); |
||
708 | end; |
||
709 | end; |
||
710 | |||
711 | FTopPBits := Pointer(Integer(FPBits)+(FHeight-1)*FWidthBytes); |
||
712 | end; |
||
713 | |||
714 | procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); |
||
715 | begin |
||
716 | if Source.FSize=0 then |
||
717 | begin |
||
718 | Create; |
||
719 | FMemoryImage := MemoryImage; |
||
720 | end else |
||
721 | begin |
||
722 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
||
723 | Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed); |
||
724 | if FCompressed then |
||
725 | begin |
||
726 | FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage; |
||
727 | GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage); |
||
728 | Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
||
729 | end else |
||
730 | begin |
||
731 | Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
||
732 | end; |
||
733 | end; |
||
734 | end; |
||
735 | |||
736 | procedure TDIBSharedImage.Compress(Source: TDIBSharedImage); |
||
737 | |||
738 | procedure EncodeRLE4; |
||
739 | var |
||
740 | Size: Integer; |
||
741 | |||
742 | function AllocByte: PByte; |
||
743 | begin |
||
744 | if Size mod 4096=0 then |
||
745 | ReAllocMem(FPBits, Size+4095); |
||
746 | Result := Pointer(Integer(FPBits)+Size); |
||
747 | Inc(Size); |
||
748 | end; |
||
749 | |||
750 | var |
||
751 | B1, B2, C: Byte; |
||
752 | PB1, PB2: Integer; |
||
753 | Src: PByte; |
||
754 | X, Y: Integer; |
||
755 | |||
756 | function GetPixel(x: Integer): Integer; |
||
757 | begin |
||
758 | if X and 1=0 then |
||
759 | Result := PArrayByte(Src)[X shr 1] shr 4 |
||
760 | else |
||
761 | Result := PArrayByte(Src)[X shr 1] and $0F; |
||
762 | end; |
||
763 | |||
764 | begin |
||
765 | Size := 0; |
||
766 | |||
767 | for y:=0 to Source.FHeight-1 do |
||
768 | begin |
||
769 | x := 0; |
||
770 | Src := Pointer(Integer(Source.FPBits)+y*FWidthBytes); |
||
771 | while x<Source.FWidth do |
||
772 | begin |
||
773 | if (Source.FWidth-x>3) and (GetPixel(x)=GetPixel(x+2)) then |
||
774 | begin |
||
775 | { Encoding mode } |
||
776 | B1 := 2; |
||
777 | B2 := (GetPixel(x) shl 4) or GetPixel(x+1); |
||
778 | |||
779 | Inc(x, 2); |
||
780 | |||
781 | C := B2; |
||
782 | |||
783 | while (x<Source.FWidth) and (C and $F=GetPixel(x)) and (B1<255) do |
||
784 | begin |
||
785 | Inc(B1); |
||
786 | Inc(x); |
||
787 | C := (C shr 4) or (C shl 4); |
||
788 | end; |
||
789 | |||
790 | AllocByte^ := B1; |
||
791 | AllocByte^ := B2; |
||
792 | end else |
||
793 | 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 |
||
795 | begin |
||
796 | { Encoding mode } |
||
797 | AllocByte^ := 2; |
||
798 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1); |
||
799 | Inc(x, 2); |
||
800 | end else |
||
801 | begin |
||
802 | if (Source.FWidth-x<4) then |
||
803 | begin |
||
804 | { Encoding mode } |
||
805 | while Source.FWidth-x>=2 do |
||
806 | begin |
||
807 | AllocByte^ := 2; |
||
808 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1); |
||
809 | Inc(x, 2); |
||
810 | end; |
||
811 | |||
812 | if Source.FWidth-x=1 then |
||
813 | begin |
||
814 | AllocByte^ := 1; |
||
815 | AllocByte^ := GetPixel(x) shl 4; |
||
816 | Inc(x); |
||
817 | end; |
||
818 | end else |
||
819 | begin |
||
820 | { Absolute mode } |
||
821 | PB1 := Size; AllocByte; |
||
822 | PB2 := Size; AllocByte; |
||
823 | |||
824 | B1 := 0; |
||
825 | B2 := 4; |
||
826 | |||
827 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1); |
||
828 | AllocByte^ := (GetPixel(x+2) shl 4) or GetPixel(x+3); |
||
829 | |||
830 | Inc(x, 4); |
||
831 | |||
832 | while (x+1<Source.FWidth) and (B2<254) do |
||
833 | begin |
||
834 | if (Source.FWidth-x>3) and (GetPixel(x)=GetPixel(x+2)) and (GetPixel(x+1)=GetPixel(x+3)) then |
||
835 | Break; |
||
836 | |||
837 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1); |
||
838 | Inc(B2, 2); |
||
839 | Inc(x, 2); |
||
840 | end; |
||
841 | |||
842 | PByte(Integer(FPBits)+PB1)^ := B1; |
||
843 | PByte(Integer(FPBits)+PB2)^ := B2; |
||
844 | end; |
||
845 | end; |
||
846 | |||
847 | if Size and 1=1 then AllocByte; |
||
848 | end; |
||
849 | |||
850 | { End of line } |
||
851 | AllocByte^ := 0; |
||
852 | AllocByte^ := 0; |
||
853 | end; |
||
854 | |||
855 | { End of bitmap } |
||
856 | AllocByte^ := 0; |
||
857 | AllocByte^ := 1; |
||
858 | |||
859 | FBitmapInfo.bmiHeader.biSizeImage := Size; |
||
860 | FSize := Size; |
||
861 | end; |
||
862 | |||
863 | procedure EncodeRLE8; |
||
864 | var |
||
865 | Size: Integer; |
||
866 | |||
867 | function AllocByte: PByte; |
||
868 | begin |
||
869 | if Size mod 4096=0 then |
||
870 | ReAllocMem(FPBits, Size+4095); |
||
871 | Result := Pointer(Integer(FPBits)+Size); |
||
872 | Inc(Size); |
||
873 | end; |
||
874 | |||
875 | var |
||
876 | B1, B2: Byte; |
||
877 | PB1, PB2: Integer; |
||
878 | Src: PByte; |
||
879 | X, Y: Integer; |
||
880 | begin |
||
881 | Size := 0; |
||
882 | |||
883 | for y:=0 to Source.FHeight-1 do |
||
884 | begin |
||
885 | x := 0; |
||
886 | Src := Pointer(Integer(Source.FPBits)+y*FWidthBytes); |
||
887 | while x<Source.FWidth do |
||
888 | begin |
||
889 | if (Source.FWidth-x>2) and (Src^=PByte(Integer(Src)+1)^) then |
||
890 | begin |
||
891 | { Encoding mode } |
||
892 | B1 := 2; |
||
893 | B2 := Src^; |
||
894 | |||
895 | Inc(x, 2); |
||
896 | Inc(Src, 2); |
||
897 | |||
898 | while (x<Source.FWidth) and (Src^=B2) and (B1<255) do |
||
899 | begin |
||
900 | Inc(B1); |
||
901 | Inc(x); |
||
902 | Inc(Src); |
||
903 | end; |
||
904 | |||
905 | AllocByte^ := B1; |
||
906 | AllocByte^ := B2; |
||
907 | end else |
||
908 | if (Source.FWidth-x>2) and (Src^<>PByte(Integer(Src)+1)^) and (PByte(Integer(Src)+1)^=PByte(Integer(Src)+2)^) then |
||
909 | begin |
||
910 | { Encoding mode } |
||
911 | AllocByte^ := 1; |
||
912 | AllocByte^ := Src^; Inc(Src); |
||
913 | Inc(x); |
||
914 | end else |
||
915 | begin |
||
916 | if (Source.FWidth-x<4) then |
||
917 | begin |
||
918 | { Encoding mode } |
||
919 | if Source.FWidth-x=2 then |
||
920 | begin |
||
921 | AllocByte^ := 1; |
||
922 | AllocByte^ := Src^; Inc(Src); |
||
923 | |||
924 | AllocByte^ := 1; |
||
925 | AllocByte^ := Src^; Inc(Src); |
||
926 | Inc(x, 2); |
||
927 | end else |
||
928 | begin |
||
929 | AllocByte^ := 1; |
||
930 | AllocByte^ := Src^; Inc(Src); |
||
931 | Inc(x); |
||
932 | end; |
||
933 | end else |
||
934 | begin |
||
935 | { Absolute mode } |
||
936 | PB1 := Size; AllocByte; |
||
937 | PB2 := Size; AllocByte; |
||
938 | |||
939 | B1 := 0; |
||
940 | B2 := 3; |
||
941 | |||
942 | Inc(x, 3); |
||
943 | |||
944 | AllocByte^ := Src^; Inc(Src); |
||
945 | AllocByte^ := Src^; Inc(Src); |
||
946 | AllocByte^ := Src^; Inc(Src); |
||
947 | |||
948 | while (x<Source.FWidth) and (B2<255) do |
||
949 | begin |
||
950 | if (Source.FWidth-x>3) and (Src^=PByte(Integer(Src)+1)^) and (Src^=PByte(Integer(Src)+2)^) and (Src^=PByte(Integer(Src)+3)^) then |
||
951 | Break; |
||
952 | |||
953 | AllocByte^ := Src^; Inc(Src); |
||
954 | Inc(B2); |
||
955 | Inc(x); |
||
956 | end; |
||
957 | |||
958 | PByte(Integer(FPBits)+PB1)^ := B1; |
||
959 | PByte(Integer(FPBits)+PB2)^ := B2; |
||
960 | end; |
||
961 | end; |
||
962 | |||
963 | if Size and 1=1 then AllocByte; |
||
964 | end; |
||
965 | |||
966 | { End of line } |
||
967 | AllocByte^ := 0; |
||
968 | AllocByte^ := 0; |
||
969 | end; |
||
970 | |||
971 | { End of bitmap } |
||
972 | AllocByte^ := 0; |
||
973 | AllocByte^ := 1; |
||
974 | |||
975 | FBitmapInfo.bmiHeader.biSizeImage := Size; |
||
976 | FSize := Size; |
||
977 | end; |
||
978 | |||
979 | begin |
||
980 | if Source.FCompressed then |
||
981 | Duplicate(Source, Source.FMemoryImage) |
||
982 | else begin |
||
983 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
||
984 | Source.FPixelFormat, Source.FColorTable, True, True); |
||
985 | case FBitmapInfo.bmiHeader.biCompression of |
||
986 | BI_RLE4: EncodeRLE4; |
||
987 | BI_RLE8: EncodeRLE8; |
||
988 | else |
||
989 | Duplicate(Source, Source.FMemoryImage); |
||
990 | end; |
||
991 | end; |
||
992 | end; |
||
993 | |||
994 | procedure TDIBSharedImage.Decompress(Source: TDIBSharedImage; MemoryImage: Boolean); |
||
995 | |||
996 | procedure DecodeRLE4; |
||
997 | var |
||
998 | B1, B2, C: Byte; |
||
999 | Dest, Src, P: PByte; |
||
1000 | X, Y, i: Integer; |
||
1001 | begin |
||
1002 | Src := Source.FPBits; |
||
1003 | X := 0; |
||
1004 | Y := 0; |
||
1005 | |||
1006 | while True do |
||
1007 | begin |
||
1008 | B1 := Src^; Inc(Src); |
||
1009 | B2 := Src^; Inc(Src); |
||
1010 | |||
1011 | if B1=0 then |
||
1012 | begin |
||
1013 | case B2 of |
||
1014 | 0: begin { End of line } |
||
1015 | X := 0; |
||
1016 | Inc(Y); |
||
1017 | end; |
||
1018 | 1: Break; { End of bitmap } |
||
1019 | 2: begin { Difference of coordinates } |
||
1020 | Inc(X, B1); |
||
1021 | Inc(Y, B2); Inc(Src, 2); |
||
1022 | end; |
||
1023 | else |
||
1024 | { Absolute mode } |
||
1025 | Dest := Pointer(Longint(FPBits)+Y*FWidthBytes); |
||
1026 | |||
1027 | C := 0; |
||
1028 | for i:=0 to B2-1 do |
||
1029 | begin |
||
1030 | if i and 1=0 then |
||
1031 | begin |
||
1032 | C := Src^; Inc(Src); |
||
1033 | end else |
||
1034 | begin |
||
1035 | C := C shl 4; |
||
1036 | end; |
||
1037 | |||
1038 | P := Pointer(Integer(Dest)+X shr 1); |
||
1039 | if X and 1=0 then |
||
1040 | P^ := (P^ and $0F) or (C and $F0) |
||
1041 | else |
||
1042 | P^ := (P^ and $F0) or ((C and $F0) shr 4); |
||
1043 | |||
1044 | Inc(X); |
||
1045 | end; |
||
1046 | end; |
||
1047 | end else |
||
1048 | begin |
||
1049 | { Encoding mode } |
||
1050 | Dest := Pointer(Longint(FPBits)+Y*FWidthBytes); |
||
1051 | |||
1052 | for i:=0 to B1-1 do |
||
1053 | begin |
||
1054 | P := Pointer(Integer(Dest)+X shr 1); |
||
1055 | if X and 1=0 then |
||
1056 | P^ := (P^ and $0F) or (B2 and $F0) |
||
1057 | else |
||
1058 | P^ := (P^ and $F0) or ((B2 and $F0) shr 4); |
||
1059 | |||
1060 | Inc(X); |
||
1061 | |||
1062 | // Swap nibble |
||
1063 | B2 := (B2 shr 4) or (B2 shl 4); |
||
1064 | end; |
||
1065 | end; |
||
1066 | |||
1067 | { Word arrangement } |
||
1068 | Inc(Src, Longint(Src) and 1); |
||
1069 | end; |
||
1070 | end; |
||
1071 | |||
1072 | procedure DecodeRLE8; |
||
1073 | var |
||
1074 | B1, B2: Byte; |
||
1075 | Dest, Src: PByte; |
||
1076 | X, Y: Integer; |
||
1077 | begin |
||
1078 | Dest := FPBits; |
||
1079 | Src := Source.FPBits; |
||
1080 | X := 0; |
||
1081 | Y := 0; |
||
1082 | |||
1083 | while True do |
||
1084 | begin |
||
1085 | B1 := Src^; Inc(Src); |
||
1086 | B2 := Src^; Inc(Src); |
||
1087 | |||
1088 | if B1=0 then |
||
1089 | begin |
||
1090 | case B2 of |
||
1091 | 0: begin { End of line } |
||
1092 | X := 0; Inc(Y); |
||
1093 | Dest := Pointer(Longint(FPBits)+Y*FWidthBytes+X); |
||
1094 | end; |
||
1095 | 1: Break; { End of bitmap } |
||
1096 | 2: begin { Difference of coordinates } |
||
1097 | Inc(X, B1); Inc(Y, B2); Inc(Src, 2); |
||
1098 | Dest := Pointer(Longint(FPBits)+Y*FWidthBytes+X); |
||
1099 | end; |
||
1100 | else |
||
1101 | { Absolute mode } |
||
1102 | Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2); |
||
1103 | end; |
||
1104 | end else |
||
1105 | begin |
||
1106 | { Encoding mode } |
||
1107 | FillChar(Dest^, B1, B2); Inc(Dest, B1); |
||
1108 | end; |
||
1109 | |||
1110 | { Word arrangement } |
||
1111 | Inc(Src, Longint(Src) and 1); |
||
1112 | end; |
||
1113 | end; |
||
1114 | |||
1115 | begin |
||
1116 | if not Source.FCompressed then |
||
1117 | Duplicate(Source, MemoryImage) |
||
1118 | else begin |
||
1119 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
||
1120 | Source.FPixelFormat, Source.FColorTable, MemoryImage, False); |
||
1121 | case Source.FBitmapInfo.bmiHeader.biCompression of |
||
1122 | BI_RLE4: DecodeRLE4; |
||
1123 | BI_RLE8: DecodeRLE8; |
||
1124 | else |
||
1125 | Duplicate(Source, MemoryImage); |
||
1126 | end; |
||
1127 | end; |
||
1128 | end; |
||
1129 | |||
1130 | procedure TDIBSharedImage.ReadData(Stream: TStream; MemoryImage: Boolean); |
||
1131 | var |
||
1132 | BI: TBitmapInfoHeader; |
||
1133 | BC: TBitmapCoreHeader; |
||
1134 | BCRGB: array[0..255] of TRGBTriple; |
||
1135 | |||
1136 | procedure LoadRLE4; |
||
1137 | begin |
||
1138 | FSize := BI.biSizeImage; |
||
1139 | FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
||
1140 | FBitmapInfo.bmiHeader.biSizeImage := FSize; |
||
1141 | Stream.ReadBuffer(FPBits^, FSize); |
||
1142 | end; |
||
1143 | |||
1144 | procedure LoadRLE8; |
||
1145 | begin |
||
1146 | FSize := BI.biSizeImage; |
||
1147 | FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
||
1148 | FBitmapInfo.bmiHeader.biSizeImage := FSize; |
||
1149 | Stream.ReadBuffer(FPBits^, FSize); |
||
1150 | end; |
||
1151 | |||
1152 | procedure LoadRGB; |
||
1153 | var |
||
1154 | y: Integer; |
||
1155 | begin |
||
1156 | if BI.biHeight<0 then |
||
1157 | begin |
||
1158 | for y:=0 to Abs(BI.biHeight)-1 do |
||
1159 | Stream.ReadBuffer(Pointer(Integer(FTopPBits)+y*FNextLine)^, FWidthBytes); |
||
1160 | end else |
||
1161 | begin |
||
1162 | Stream.ReadBuffer(FPBits^, FSize); |
||
1163 | end; |
||
1164 | end; |
||
1165 | |||
1166 | var |
||
1167 | i, PalCount: Integer; |
||
1168 | OS2: Boolean; |
||
1169 | Localpf: TLocalDIBPixelFormat; |
||
1170 | AColorTable: TRGBQuads; |
||
1171 | APixelFormat: TDIBPixelFormat; |
||
1172 | begin |
||
1173 | { Header size reading } |
||
1174 | i := Stream.Read(BI.biSize, 4); |
||
1175 | |||
1176 | if i=0 then |
||
1177 | begin |
||
1178 | Create; |
||
1179 | Exit; |
||
1180 | end; |
||
1181 | if i<>4 then |
||
1182 | raise EInvalidGraphic.Create(SInvalidDIB); |
||
1183 | |||
1184 | { Kind check of DIB } |
||
1185 | OS2 := False; |
||
1186 | |||
1187 | case BI.biSize of |
||
1188 | SizeOf(TBitmapCoreHeader): |
||
1189 | begin |
||
1190 | { OS/2 type } |
||
1191 | Stream.ReadBuffer(Pointer(Integer(@BC)+4)^, SizeOf(TBitmapCoreHeader)-4); |
||
1192 | |||
1193 | with BI do |
||
1194 | begin |
||
1195 | biClrUsed := 0; |
||
1196 | biCompression := BI_RGB; |
||
1197 | biBitCount := BC.bcBitCount; |
||
1198 | biHeight := BC.bcHeight; |
||
1199 | biWidth := BC.bcWidth; |
||
1200 | end; |
||
1201 | |||
1202 | OS2 := True; |
||
1203 | end; |
||
1204 | SizeOf(TBitmapInfoHeader): |
||
1205 | begin |
||
1206 | { Windows type } |
||
1207 | Stream.ReadBuffer(Pointer(Integer(@BI)+4)^, SizeOf(TBitmapInfoHeader)-4); |
||
1208 | end; |
||
1209 | else |
||
1210 | raise EInvalidGraphic.Create(SInvalidDIB); |
||
1211 | end; |
||
1212 | |||
1213 | { Bit mask reading. } |
||
1214 | if BI.biCompression = BI_BITFIELDS then |
||
1215 | begin |
||
1216 | Stream.ReadBuffer(Localpf, SizeOf(Localpf)); |
||
1217 | with Localpf do |
||
1218 | APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask); |
||
1219 | end else |
||
1220 | begin |
||
1221 | if BI.biBitCount=16 then |
||
1222 | APixelFormat := MakeDIBPixelFormat(5, 5, 5) |
||
1223 | else if BI.biBitCount=32 then |
||
1224 | APixelFormat := MakeDIBPixelFormat(8, 8, 8) |
||
1225 | else |
||
1226 | APixelFormat := MakeDIBPixelFormat(8, 8, 8); |
||
1227 | end; |
||
1228 | |||
1229 | { Palette reading } |
||
1230 | PalCount := BI.biClrUsed; |
||
1231 | if (PalCount=0) and (BI.biBitCount<=8) then |
||
1232 | PalCount := 1 shl BI.biBitCount; |
||
1233 | if PalCount>256 then PalCount := 256; |
||
1234 | |||
1235 | FillChar(AColorTable, SizeOf(AColorTable), 0); |
||
1236 | |||
1237 | if OS2 then |
||
1238 | begin |
||
1239 | { OS/2 type } |
||
1240 | Stream.ReadBuffer(BCRGB, SizeOf(TRGBTriple)*PalCount); |
||
1241 | for i:=0 to PalCount-1 do |
||
1242 | begin |
||
1243 | with BCRGB[i] do |
||
1244 | AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue); |
||
1245 | end; |
||
1246 | end else |
||
1247 | begin |
||
1248 | { Windows type } |
||
1249 | Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad)*PalCount); |
||
1250 | end; |
||
1251 | |||
1252 | { DIB ì¬ } |
||
1253 | NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable, |
||
1254 | MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]); |
||
1255 | |||
1256 | { Pixel data reading } |
||
1257 | case BI.biCompression of |
||
1258 | BI_RGB : LoadRGB; |
||
1259 | BI_RLE4 : LoadRLE4; |
||
1260 | BI_RLE8 : LoadRLE8; |
||
1261 | BI_BITFIELDS: LoadRGB; |
||
1262 | else |
||
1263 | raise EInvalidGraphic.Create(SInvalidDIB); |
||
1264 | end; |
||
1265 | end; |
||
1266 | |||
1267 | destructor TDIBSharedImage.Destroy; |
||
1268 | begin |
||
1269 | if FHandle<>0 then |
||
1270 | begin |
||
1271 | if FOldHandle<>0 then SelectObject(FDC, FOldHandle); |
||
1272 | DeleteObject(FHandle); |
||
1273 | end else |
||
1274 | begin |
||
1275 | if FPBits<>nil then |
||
1276 | GlobalFreePtr(FPBits); |
||
1277 | end; |
||
1278 | |||
1279 | PaletteManager.DeletePalette(FPalette); |
||
1280 | if FDC<>0 then DeleteDC(FDC); |
||
1281 | |||
1282 | FreeMem(FBitmapInfo); |
||
1283 | inherited Destroy; |
||
1284 | end; |
||
1285 | |||
1286 | procedure TDIBSharedImage.FreeHandle; |
||
1287 | begin |
||
1288 | end; |
||
1289 | |||
1290 | function TDIBSharedImage.GetPalette: THandle; |
||
1291 | begin |
||
1292 | if FPaletteCount>0 then |
||
1293 | begin |
||
1294 | if FChangePalette then |
||
1295 | begin |
||
1296 | FChangePalette := False; |
||
1297 | PaletteManager.DeletePalette(FPalette); |
||
1298 | FPalette := PaletteManager.CreatePalette(FColorTable, FPaletteCount); |
||
1299 | end; |
||
1300 | Result := FPalette; |
||
1301 | end else |
||
1302 | Result := 0; |
||
1303 | end; |
||
1304 | |||
1305 | procedure TDIBSharedImage.SetColorTable(const Value: TRGBQuads); |
||
1306 | begin |
||
1307 | FColorTable := Value; |
||
1308 | FChangePalette := True; |
||
1309 | |||
1310 | if (FSize>0) and (FPaletteCount>0) then |
||
1311 | begin |
||
1312 | SetDIBColorTable(FDC, 0, 256, FColorTable); |
||
1313 | Move(FColorTable, Pointer(Integer(FBitmapInfo)+FColorTablePos)^, SizeOf(TRGBQuad)*FPaletteCount); |
||
1314 | end; |
||
1315 | end; |
||
1316 | |||
1317 | { TDIB } |
||
1318 | |||
1319 | var |
||
1320 | FEmptyDIBImage: TDIBSharedImage; |
||
1321 | |||
1322 | function EmptyDIBImage: TDIBSharedImage; |
||
1323 | begin |
||
1324 | if FEmptyDIBImage=nil then |
||
1325 | begin |
||
1326 | FEmptyDIBImage := TDIBSharedImage.Create; |
||
1327 | FEmptyDIBImage.Reference; |
||
1328 | end; |
||
1329 | Result := FEmptyDIBImage; |
||
1330 | end; |
||
1331 | |||
1332 | constructor TDIB.Create; |
||
1333 | begin |
||
1334 | inherited Create; |
||
1335 | SetImage(EmptyDIBImage); |
||
1336 | end; |
||
1337 | |||
1338 | destructor TDIB.Destroy; |
||
1339 | begin |
||
1340 | SetImage(EmptyDIBImage); |
||
1341 | FCanvas.Free; |
||
1342 | inherited Destroy; |
||
1343 | end; |
||
1344 | |||
1345 | procedure TDIB.Assign(Source: TPersistent); |
||
1346 | |||
1347 | procedure AssignBitmap(Source: TBitmap); |
||
1348 | var |
||
1349 | Data: array[0..1023] of Byte; |
||
1350 | BitmapRec: Windows.PBitmap; |
||
1351 | DIBSectionRec: PDIBSection; |
||
1352 | PaletteEntries: TPaletteEntries; |
||
1353 | begin |
||
1354 | GetPaletteEntries(Source.Palette, 0, 256, PaletteEntries); |
||
1355 | ColorTable := PaletteEntriesToRGBQuads(PaletteEntries); |
||
1356 | UpdatePalette; |
||
1357 | |||
1358 | case GetObject(Source.Handle, SizeOf(Data), @Data) of |
||
1359 | SizeOf(Windows.TBitmap): |
||
1360 | begin |
||
1361 | BitmapRec := @Data; |
||
1362 | case BitmapRec^.bmBitsPixel of |
||
1363 | 16: PixelFormat := MakeDIBPixelFormat(5, 5, 5); |
||
1364 | else |
||
1365 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
||
1366 | end; |
||
1367 | SetSize(BitmapRec^.bmWidth, BitmapRec^.bmHeight, BitmapRec^.bmBitsPixel); |
||
1368 | end; |
||
1369 | SizeOf(TDIBSection): |
||
1370 | begin |
||
1371 | DIBSectionRec := @Data; |
||
1372 | if DIBSectionRec^.dsBm.bmBitsPixel>=24 then |
||
1373 | begin |
||
1374 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
||
1375 | end else |
||
1376 | if DIBSectionRec^.dsBm.bmBitsPixel>8 then |
||
1377 | begin |
||
1378 | PixelFormat := MakeDIBPixelFormat(DIBSectionRec^.dsBitfields[0], |
||
1379 | DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]); |
||
1380 | end else |
||
1381 | begin |
||
1382 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
||
1383 | end; |
||
1384 | SetSize(DIBSectionRec^.dsBm.bmWidth, DIBSectionRec^.dsBm.bmHeight, |
||
1385 | DIBSectionRec^.dsBm.bmBitsPixel); |
||
1386 | end; |
||
1387 | else |
||
1388 | Exit; |
||
1389 | end; |
||
1390 | |||
1391 | FillChar(PBits^, Size, 0); |
||
1392 | Canvas.Draw(0, 0, Source); |
||
1393 | end; |
||
1394 | |||
1395 | procedure AssignGraphic(Source: TGraphic); |
||
1396 | begin |
||
1397 | if Source is TBitmap then |
||
1398 | AssignBitmap(TBitmap(Source)) |
||
1399 | else |
||
1400 | begin |
||
1401 | SetSize(Source.Width, Source.Height, 24); |
||
1402 | FillChar(PBits^, Size, 0); |
||
1403 | Canvas.Draw(0, 0, Source); |
||
1404 | end; |
||
1405 | end; |
||
1406 | |||
1407 | begin |
||
1408 | if Source=nil then |
||
1409 | begin |
||
1410 | Clear; |
||
1411 | end else if Source is TDIB then |
||
1412 | begin |
||
1413 | if Source<>Self then |
||
1414 | SetImage(TDIB(Source).FImage); |
||
1415 | end else if Source is TGraphic then |
||
1416 | begin |
||
1417 | AssignGraphic(TGraphic(Source)); |
||
1418 | end else if Source is TPicture then |
||
1419 | begin |
||
1420 | if TPicture(Source).Graphic<>nil then |
||
1421 | AssignGraphic(TPicture(Source).Graphic) |
||
1422 | else |
||
1423 | Clear; |
||
1424 | end else |
||
1425 | inherited Assign(Source); |
||
1426 | end; |
||
1427 | |||
1428 | procedure TDIB.Draw(ACanvas: TCanvas; const Rect: TRect); |
||
1429 | var |
||
1430 | OldPalette: HPalette; |
||
1431 | OldMode: Integer; |
||
1432 | begin |
||
1433 | if Size>0 then |
||
1434 | begin |
||
1435 | if PaletteCount>0 then |
||
1436 | begin |
||
1437 | OldPalette := SelectPalette(ACanvas.Handle, Palette, False); |
||
1438 | RealizePalette(ACanvas.Handle); |
||
1439 | end else |
||
1440 | OldPalette := 0; |
||
1441 | try |
||
1442 | OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR); |
||
1443 | try |
||
1444 | GdiFlush; |
||
1445 | if FImage.FMemoryImage then |
||
1446 | begin |
||
1447 | with Rect do |
||
1448 | StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
||
1449 | 0, 0, Width, Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS , ACanvas.CopyMode); |
||
1450 | end else |
||
1451 | begin |
||
1452 | with Rect do |
||
1453 | StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
||
1454 | FImage.FDC, 0, 0, Width, Height, ACanvas.CopyMode); |
||
1455 | end; |
||
1456 | finally |
||
1457 | SetStretchBltMode(ACanvas.Handle, OldMode); |
||
1458 | end; |
||
1459 | finally |
||
1460 | SelectPalette(ACanvas.Handle, OldPalette, False); |
||
1461 | end; |
||
1462 | end; |
||
1463 | end; |
||
1464 | |||
1465 | procedure TDIB.Clear; |
||
1466 | begin |
||
1467 | SetImage(EmptyDIBImage); |
||
1468 | end; |
||
1469 | |||
1470 | procedure TDIB.CanvasChanging(Sender: TObject); |
||
1471 | begin |
||
1472 | Changing(False); |
||
1473 | end; |
||
1474 | |||
1475 | procedure TDIB.Changing(MemoryImage: Boolean); |
||
1476 | var |
||
1477 | TempImage: TDIBSharedImage; |
||
1478 | begin |
||
1479 | if (FImage.RefCount>1) or (FImage.FCompressed) or ((not MemoryImage) and (FImage.FMemoryImage)) then |
||
1480 | begin |
||
1481 | TempImage := TDIBSharedImage.Create; |
||
1482 | try |
||
1483 | TempImage.Decompress(FImage, FImage.FMemoryImage and MemoryImage); |
||
1484 | except |
||
1485 | TempImage.Free; |
||
1486 | raise; |
||
1487 | end; |
||
1488 | SetImage(TempImage); |
||
1489 | end; |
||
1490 | end; |
||
1491 | |||
1492 | procedure TDIB.AllocHandle; |
||
1493 | var |
||
1494 | TempImage: TDIBSharedImage; |
||
1495 | begin |
||
1496 | if FImage.FMemoryImage then |
||
1497 | begin |
||
1498 | TempImage := TDIBSharedImage.Create; |
||
1499 | try |
||
1500 | TempImage.Decompress(FImage, False); |
||
1501 | except |
||
1502 | TempImage.Free; |
||
1503 | raise; |
||
1504 | end; |
||
1505 | SetImage(TempImage); |
||
1506 | end; |
||
1507 | end; |
||
1508 | |||
1509 | procedure TDIB.Compress; |
||
1510 | var |
||
1511 | TempImage: TDIBSharedImage; |
||
1512 | begin |
||
1513 | if (not FImage.FCompressed) and (BitCount in [4, 8]) then |
||
1514 | begin |
||
1515 | TempImage := TDIBSharedImage.Create; |
||
1516 | try |
||
1517 | TempImage.Compress(FImage); |
||
1518 | except |
||
1519 | TempImage.Free; |
||
1520 | raise; |
||
1521 | end; |
||
1522 | SetImage(TempImage); |
||
1523 | end; |
||
1524 | end; |
||
1525 | |||
1526 | procedure TDIB.Decompress; |
||
1527 | var |
||
1528 | TempImage: TDIBSharedImage; |
||
1529 | begin |
||
1530 | if FImage.FCompressed then |
||
1531 | begin |
||
1532 | TempImage := TDIBSharedImage.Create; |
||
1533 | try |
||
1534 | TempImage.Decompress(FImage, FImage.FMemoryImage); |
||
1535 | except |
||
1536 | TempImage.Free; |
||
1537 | raise; |
||
1538 | end; |
||
1539 | SetImage(TempImage); |
||
1540 | end; |
||
1541 | end; |
||
1542 | |||
1543 | procedure TDIB.FreeHandle; |
||
1544 | var |
||
1545 | TempImage: TDIBSharedImage; |
||
1546 | begin |
||
1547 | if not FImage.FMemoryImage then |
||
1548 | begin |
||
1549 | TempImage := TDIBSharedImage.Create; |
||
1550 | try |
||
1551 | TempImage.Duplicate(FImage, True); |
||
1552 | except |
||
1553 | TempImage.Free; |
||
1554 | raise; |
||
1555 | end; |
||
1556 | SetImage(TempImage); |
||
1557 | end; |
||
1558 | end; |
||
1559 | |||
1560 | function TDIB.GetBitmapInfo: PBitmapInfo; |
||
1561 | begin |
||
1562 | Result := FImage.FBitmapInfo; |
||
1563 | end; |
||
1564 | |||
1565 | function TDIB.GetBitmapInfoSize: Integer; |
||
1566 | begin |
||
1567 | Result := FImage.FBitmapInfoSize; |
||
1568 | end; |
||
1569 | |||
1570 | function TDIB.GetCanvas: TCanvas; |
||
1571 | begin |
||
1572 | if (FCanvas=nil) or (FCanvas.Handle=0) then |
||
1573 | begin |
||
1574 | AllocHandle; |
||
1575 | |||
1576 | FCanvas := TCanvas.Create; |
||
1577 | FCanvas.Handle := FImage.FDC; |
||
1578 | FCanvas.OnChanging := CanvasChanging; |
||
1579 | end; |
||
1580 | Result := FCanvas; |
||
1581 | end; |
||
1582 | |||
1583 | function TDIB.GetEmpty: Boolean; |
||
1584 | begin |
||
1585 | Result := Size=0; |
||
1586 | end; |
||
1587 | |||
1588 | function TDIB.GetHandle: THandle; |
||
1589 | begin |
||
1590 | Changing(True); |
||
1591 | Result := FImage.FHandle; |
||
1592 | end; |
||
1593 | |||
1594 | function TDIB.GetHeight: Integer; |
||
1595 | begin |
||
1596 | Result := FHeight; |
||
1597 | end; |
||
1598 | |||
1599 | function TDIB.GetPalette: HPalette; |
||
1600 | begin |
||
1601 | Result := FImage.GetPalette; |
||
1602 | end; |
||
1603 | |||
1604 | function TDIB.GetPaletteCount: Integer; |
||
1605 | begin |
||
1606 | Result := FImage.FPaletteCount; |
||
1607 | end; |
||
1608 | |||
1609 | function TDIB.GetPBits: Pointer; |
||
1610 | begin |
||
1611 | Changing(True); |
||
1612 | |||
1613 | if not FImage.FMemoryImage then |
||
1614 | GDIFlush; |
||
1615 | Result := FPBits; |
||
1616 | end; |
||
1617 | |||
1618 | function TDIB.GetPBitsReadOnly: Pointer; |
||
1619 | begin |
||
1620 | if not FImage.FMemoryImage then |
||
1621 | GDIFlush; |
||
1622 | Result := FPBits; |
||
1623 | end; |
||
1624 | |||
1625 | function TDIB.GetScanLine(Y: Integer): Pointer; |
||
1626 | begin |
||
1627 | Changing(True); |
||
1628 | if (Y<0) or (Y>=FHeight) then |
||
1629 | raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]); |
||
1630 | |||
1631 | if not FImage.FMemoryImage then |
||
1632 | GDIFlush; |
||
1633 | Result := Pointer(Integer(FTopPBits)+Y*FNextLine); |
||
1634 | end; |
||
1635 | |||
1636 | function TDIB.GetScanLineReadOnly(Y: Integer): Pointer; |
||
1637 | begin |
||
1638 | if (Y<0) or (Y>=FHeight) then |
||
1639 | raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]); |
||
1640 | |||
1641 | if not FImage.FMemoryImage then |
||
1642 | GDIFlush; |
||
1643 | Result := Pointer(Integer(FTopPBits)+Y*FNextLine); |
||
1644 | end; |
||
1645 | |||
1646 | function TDIB.GetTopPBits: Pointer; |
||
1647 | begin |
||
1648 | Changing(True); |
||
1649 | |||
1650 | if not FImage.FMemoryImage then |
||
1651 | GDIFlush; |
||
1652 | Result := FTopPBits; |
||
1653 | end; |
||
1654 | |||
1655 | function TDIB.GetTopPBitsReadOnly: Pointer; |
||
1656 | begin |
||
1657 | if not FImage.FMemoryImage then |
||
1658 | GDIFlush; |
||
1659 | Result := FTopPBits; |
||
1660 | end; |
||
1661 | |||
1662 | function TDIB.GetWidth: Integer; |
||
1663 | begin |
||
1664 | Result := FWidth; |
||
1665 | end; |
||
1666 | |||
1667 | const |
||
1668 | Mask1: array[0..7] of DWORD = ($80, $40, $20, $10, $08, $04, $02, $01); |
||
1669 | Mask1n: array[0..7] of DWORD = ($FFFFFF7F, $FFFFFFBF, $FFFFFFDF, $FFFFFFEF, |
||
1670 | $FFFFFFF7, $FFFFFFFB, $FFFFFFFD, $FFFFFFFE); |
||
1671 | Mask4: array[0..1] of DWORD = ($F0, $0F); |
||
1672 | Mask4n: array[0..1] of DWORD = ($FFFFFF0F, $FFFFFFF0); |
||
1673 | |||
1674 | Shift1: array[0..7] of DWORD = (7, 6, 5, 4, 3, 2, 1, 0); |
||
1675 | Shift4: array[0..1] of DWORD = (4, 0); |
||
1676 | |||
1677 | function TDIB.GetPixel(X, Y: Integer): DWORD; |
||
1678 | begin |
||
1679 | Decompress; |
||
1680 | |||
1681 | Result := 0; |
||
1682 | if (X>=0) and (X<FWidth) and (Y>=0) and (Y<FHeight) then |
||
1683 | begin |
||
1684 | case FBitCount of |
||
1685 | 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]; |
||
1687 | 8 : Result := PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X]; |
||
1688 | 16: Result := PArrayWord(Integer(FTopPBits)+Y*FNextLine)[X]; |
||
1689 | 24: with PArrayBGR(Integer(FTopPBits)+Y*FNextLine)[X] do |
||
1690 | Result := R or (G shl 8) or (B shl 16); |
||
1691 | 32: Result := PArrayDWord(Integer(FTopPBits)+Y*FNextLine)[X]; |
||
1692 | end; |
||
1693 | end; |
||
1694 | end; |
||
1695 | |||
1696 | procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD); |
||
1697 | var |
||
1698 | P: PByte; |
||
1699 | begin |
||
1700 | Changing(True); |
||
1701 | |||
1702 | if (X>=0) and (X<FWidth) and (Y>=0) and (Y<FHeight) then |
||
1703 | begin |
||
1704 | case FBitCount of |
||
1705 | 1 : begin |
||
1706 | 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]); |
||
1708 | end; |
||
1709 | 4 : begin |
||
1710 | 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]); |
||
1712 | end; |
||
1713 | 8 : PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X] := Value; |
||
1714 | 16: PArrayWord(Integer(FTopPBits)+Y*FNextLine)[X] := Value; |
||
1715 | 24: with PArrayBGR(Integer(FTopPBits)+Y*FNextLine)[X] do |
||
1716 | begin |
||
1717 | B := Byte(Value shr 16); |
||
1718 | G := Byte(Value shr 8); |
||
1719 | R := Byte(Value); |
||
1720 | end; |
||
1721 | 32: PArrayDWord(Integer(FTopPBits)+Y*FNextLine)[X] := Value; |
||
1722 | end; |
||
1723 | end; |
||
1724 | end; |
||
1725 | |||
1726 | procedure TDIB.DefineProperties(Filer: TFiler); |
||
1727 | begin |
||
1728 | inherited DefineProperties(Filer); |
||
1729 | { For interchangeability with an old version. } |
||
1730 | Filer.DefineBinaryProperty('DIB', LoadFromStream, nil, False); |
||
1731 | end; |
||
1732 | |||
1733 | type |
||
1734 | TGlobalMemoryStream = class(TMemoryStream) |
||
1735 | private |
||
1736 | FHandle: THandle; |
||
1737 | public |
||
1738 | constructor Create(AHandle: THandle); |
||
1739 | destructor Destroy; override; |
||
1740 | end; |
||
1741 | |||
1742 | constructor TGlobalMemoryStream.Create(AHandle: THandle); |
||
1743 | begin |
||
1744 | inherited Create; |
||
1745 | FHandle := AHandle; |
||
1746 | SetPointer(GlobalLock(AHandle), GlobalSize(AHandle)); |
||
1747 | end; |
||
1748 | |||
1749 | destructor TGlobalMemoryStream.Destroy; |
||
1750 | begin |
||
1751 | GlobalUnLock(FHandle); |
||
1752 | SetPointer(nil, 0); |
||
1753 | inherited Destroy; |
||
1754 | end; |
||
1755 | |||
1756 | procedure TDIB.LoadFromClipboardFormat(AFormat: Word; AData: THandle; |
||
1757 | APalette: HPALETTE); |
||
1758 | var |
||
1759 | Stream: TGlobalMemoryStream; |
||
1760 | begin |
||
1761 | Stream := TGlobalMemoryStream.Create(AData); |
||
1762 | try |
||
1763 | ReadData(Stream); |
||
1764 | finally |
||
1765 | Stream.Free; |
||
1766 | end; |
||
1767 | end; |
||
1768 | |||
1769 | const |
||
1770 | BitmapFileType = Ord('B') + Ord('M')*$100; |
||
1771 | |||
1772 | procedure TDIB.LoadFromStream(Stream: TStream); |
||
1773 | var |
||
1774 | BF: TBitmapFileHeader; |
||
1775 | i: Integer; |
||
1776 | begin |
||
1777 | { File header reading } |
||
1778 | i := Stream.Read(BF, SizeOf(TBitmapFileHeader)); |
||
1779 | if i=0 then Exit; |
||
1780 | if i<>SizeOf(TBitmapFileHeader) then |
||
1781 | raise EInvalidGraphic.Create(SInvalidDIB); |
||
1782 | |||
1783 | { Is the head 'BM'? } |
||
1784 | if BF.bfType<>BitmapFileType then |
||
1785 | raise EInvalidGraphic.Create(SInvalidDIB); |
||
1786 | |||
1787 | ReadData(Stream); |
||
1788 | end; |
||
1789 | |||
1790 | procedure TDIB.ReadData(Stream: TStream); |
||
1791 | var |
||
1792 | TempImage: TDIBSharedImage; |
||
1793 | begin |
||
1794 | TempImage := TDIBSharedImage.Create; |
||
1795 | try |
||
1796 | TempImage.ReadData(Stream, FImage.FMemoryImage); |
||
1797 | except |
||
1798 | TempImage.Free; |
||
1799 | raise; |
||
1800 | end; |
||
1801 | SetImage(TempImage); |
||
1802 | end; |
||
1803 | |||
1804 | procedure TDIB.SaveToClipboardFormat(var AFormat: Word; var AData: THandle; |
||
1805 | var APalette: HPALETTE); |
||
1806 | var |
||
1807 | P: Pointer; |
||
1808 | Stream: TMemoryStream; |
||
1809 | begin |
||
1810 | AFormat := CF_DIB; |
||
1811 | APalette := 0; |
||
1812 | |||
1813 | Stream := TMemoryStream.Create; |
||
1814 | try |
||
1815 | WriteData(Stream); |
||
1816 | |||
1817 | AData := GlobalAlloc(GHND, Stream.Size); |
||
1818 | if AData=0 then OutOfMemoryError; |
||
1819 | |||
1820 | P := GlobalLock(AData); |
||
1821 | Move(Stream.Memory^, P^, Stream.Size); |
||
1822 | GlobalUnLock(AData); |
||
1823 | finally |
||
1824 | Stream.Free; |
||
1825 | end; |
||
1826 | end; |
||
1827 | |||
1828 | procedure TDIB.SaveToStream(Stream: TStream); |
||
1829 | var |
||
1830 | BF: TBitmapFileHeader; |
||
1831 | begin |
||
1832 | if Empty then Exit; |
||
1833 | |||
1834 | with BF do |
||
1835 | begin |
||
1836 | bfType := BitmapFileType; |
||
1837 | bfOffBits := SizeOf(TBitmapFileHeader)+BitmapInfoSize; |
||
1838 | bfSize := bfOffBits+FImage.FBitmapInfo^.bmiHeader.biSizeImage; |
||
1839 | bfReserved1 := 0; |
||
1840 | bfReserved2 := 0; |
||
1841 | end; |
||
1842 | Stream.WriteBuffer(BF, SizeOf(TBitmapFileHeader)); |
||
1843 | |||
1844 | WriteData(Stream); |
||
1845 | end; |
||
1846 | |||
1847 | procedure TDIB.WriteData(Stream: TStream); |
||
1848 | begin |
||
1849 | if Empty then Exit; |
||
1850 | |||
1851 | if not FImage.FMemoryImage then |
||
1852 | GDIFlush; |
||
1853 | |||
1854 | Stream.WriteBuffer(FImage.FBitmapInfo^, FImage.FBitmapInfoSize); |
||
1855 | Stream.WriteBuffer(FImage.FPBits^, FImage.FBitmapInfo.bmiHeader.biSizeImage); |
||
1856 | end; |
||
1857 | |||
1858 | procedure TDIB.SetBitCount(Value: Integer); |
||
1859 | begin |
||
1860 | if Value<=0 then |
||
1861 | Clear |
||
1862 | else |
||
1863 | begin |
||
1864 | if Empty then |
||
1865 | begin |
||
1866 | SetSize(Max(Width, 1), Max(Height, 1), Value) |
||
1867 | end else |
||
1868 | begin |
||
1869 | ConvertBitCount(Value); |
||
1870 | end; |
||
1871 | end; |
||
1872 | end; |
||
1873 | |||
1874 | procedure TDIB.SetHeight(Value: Integer); |
||
1875 | begin |
||
1876 | if Value<=0 then |
||
1877 | Clear |
||
1878 | else |
||
1879 | begin |
||
1880 | if Empty then |
||
1881 | SetSize(Max(Width, 1), Value, 8) |
||
1882 | else |
||
1883 | SetSize(Width, Value, BitCount); |
||
1884 | end; |
||
1885 | end; |
||
1886 | |||
1887 | procedure TDIB.SetWidth(Value: Integer); |
||
1888 | begin |
||
1889 | if Value<=0 then |
||
1890 | Clear |
||
1891 | else |
||
1892 | begin |
||
1893 | if Empty then |
||
1894 | SetSize(Value, Max(Height, 1), 8) |
||
1895 | else |
||
1896 | SetSize(Value, Height, BitCount); |
||
1897 | end; |
||
1898 | end; |
||
1899 | |||
1900 | procedure TDIB.SetImage(Value: TDIBSharedImage); |
||
1901 | begin |
||
1902 | if FImage<>Value then |
||
1903 | begin |
||
1904 | if FCanvas<>nil then |
||
1905 | FCanvas.Handle := 0; |
||
1906 | |||
1907 | FImage.Release; |
||
1908 | FImage := Value; |
||
1909 | FImage.Reference; |
||
1910 | |||
1911 | if FCanvas<>nil then |
||
1912 | FCanvas.Handle := FImage.FDC; |
||
1913 | |||
1914 | ColorTable := FImage.FColorTable; |
||
1915 | PixelFormat := FImage.FPixelFormat; |
||
1916 | |||
1917 | FBitCount := FImage.FBitCount; |
||
1918 | FHeight := FImage.FHeight; |
||
1919 | FNextLine := FImage.FNextLine; |
||
1920 | FNowPixelFormat := FImage.FPixelFormat; |
||
1921 | FPBits := FImage.FPBits; |
||
1922 | FSize := FImage.FSize; |
||
1923 | FTopPBits := FImage.FTopPBits; |
||
1924 | FWidth := FImage.FWidth; |
||
1925 | FWidthBytes := FImage.FWidthBytes; |
||
1926 | end; |
||
1927 | end; |
||
1928 | |||
1929 | procedure TDIB.SetNowPixelFormat(const Value: TDIBPixelFormat); |
||
1930 | var |
||
1931 | Temp: TDIB; |
||
1932 | begin |
||
1933 | if CompareMem(@Value, @FImage.FPixelFormat, SizeOf(TDIBPixelFormat)) then exit; |
||
1934 | |||
1935 | PixelFormat := Value; |
||
1936 | |||
1937 | Temp := TDIB.Create; |
||
1938 | try |
||
1939 | Temp.Assign(Self); |
||
1940 | SetSize(Width, Height, BitCount); |
||
1941 | Canvas.Draw(0, 0, Temp); |
||
1942 | finally |
||
1943 | Temp.Free; |
||
1944 | end; |
||
1945 | end; |
||
1946 | |||
1947 | procedure TDIB.SetPalette(Value: HPalette); |
||
1948 | var |
||
1949 | PaletteEntries: TPaletteEntries; |
||
1950 | begin |
||
1951 | GetPaletteEntries(Value, 0, 256, PaletteEntries); |
||
1952 | DeleteObject(Value); |
||
1953 | |||
1954 | ColorTable := PaletteEntriesToRGBQuads(PaletteEntries); |
||
1955 | UpdatePalette; |
||
1956 | end; |
||
1957 | |||
1958 | procedure TDIB.SetSize(AWidth, AHeight, ABitCount: Integer); |
||
1959 | var |
||
1960 | TempImage: TDIBSharedImage; |
||
1961 | begin |
||
1962 | if (AWidth=Width) and (AHeight=Height) and (ABitCount=BitCount) and |
||
1963 | (NowPixelFormat.RBitMask=PixelFormat.RBitMask) and |
||
1964 | (NowPixelFormat.GBitMask=PixelFormat.GBitMask) and |
||
1965 | (NowPixelFormat.BBitMask=PixelFormat.BBitMask) then Exit; |
||
1966 | |||
1967 | if (AWidth<=0) or (AHeight<=0) then |
||
1968 | begin |
||
1969 | Clear; |
||
1970 | Exit; |
||
1971 | end; |
||
1972 | |||
1973 | TempImage := TDIBSharedImage.Create; |
||
1974 | try |
||
1975 | TempImage.NewImage(AWidth, AHeight, ABitCount, |
||
1976 | PixelFormat, ColorTable, FImage.FMemoryImage, False); |
||
1977 | except |
||
1978 | TempImage.Free; |
||
1979 | raise; |
||
1980 | end; |
||
1981 | SetImage(TempImage); |
||
1982 | |||
1983 | PaletteModified := True; |
||
1984 | end; |
||
1985 | |||
1986 | procedure TDIB.UpdatePalette; |
||
1987 | var |
||
1988 | Col: TRGBQuads; |
||
1989 | begin |
||
1990 | if CompareMem(@ColorTable, @FImage.FColorTable, SizeOf(ColorTable)) then Exit; |
||
1991 | |||
1992 | Col := ColorTable; |
||
1993 | Changing(True); |
||
1994 | ColorTable := Col; |
||
1995 | FImage.SetColorTable(ColorTable); |
||
1996 | |||
1997 | PaletteModified := True; |
||
1998 | end; |
||
1999 | |||
2000 | procedure TDIB.ConvertBitCount(ABitCount: Integer); |
||
2001 | var |
||
2002 | Temp: TDIB; |
||
2003 | |||
2004 | procedure CreateHalftonePalette(R, G, B: Integer); |
||
2005 | var |
||
2006 | i: Integer; |
||
2007 | begin |
||
2008 | for i:=0 to 255 do |
||
2009 | with ColorTable[i] do |
||
2010 | begin |
||
2011 | rgbRed := ((i shr (G+B-1)) and (1 shl R-1)) * 255 div (1 shl R-1); |
||
2012 | rgbGreen := ((i shr (B-1)) and (1 shl G-1)) * 255 div (1 shl G-1); |
||
2013 | rgbBlue := ((i shr 0) and (1 shl B-1)) * 255 div (1 shl B-1); |
||
2014 | end; |
||
2015 | end; |
||
2016 | |||
2017 | procedure PaletteToPalette_Inc; |
||
2018 | var |
||
2019 | x, y: Integer; |
||
2020 | i: DWORD; |
||
2021 | SrcP, DestP: Pointer; |
||
2022 | P: PByte; |
||
2023 | begin |
||
2024 | i := 0; |
||
2025 | |||
2026 | for y:=0 to Height-1 do |
||
2027 | begin |
||
2028 | SrcP := Temp.ScanLine[y]; |
||
2029 | DestP := ScanLine[y]; |
||
2030 | |||
2031 | for x:=0 to Width-1 do |
||
2032 | begin |
||
2033 | case Temp.BitCount of |
||
2034 | 1 : begin |
||
2035 | i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; |
||
2036 | end; |
||
2037 | 4 : begin |
||
2038 | i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1]; |
||
2039 | end; |
||
2040 | 8 : begin |
||
2041 | i := PByte(SrcP)^; |
||
2042 | Inc(PByte(SrcP)); |
||
2043 | end; |
||
2044 | end; |
||
2045 | |||
2046 | case BitCount of |
||
2047 | 1 : begin |
||
2048 | P := @PArrayByte(DestP)[X shr 3]; |
||
2049 | P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]); |
||
2050 | end; |
||
2051 | 4 : begin |
||
2052 | P := @PArrayByte(DestP)[X shr 1]; |
||
2053 | P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]); |
||
2054 | end; |
||
2055 | 8 : begin |
||
2056 | PByte(DestP)^ := i; |
||
2057 | Inc(PByte(DestP)); |
||
2058 | end; |
||
2059 | end; |
||
2060 | end; |
||
2061 | end; |
||
2062 | end; |
||
2063 | |||
2064 | procedure PaletteToRGB_or_RGBToRGB; |
||
2065 | var |
||
2066 | x, y: Integer; |
||
2067 | SrcP, DestP: Pointer; |
||
2068 | cR, cG, cB: Byte; |
||
2069 | begin |
||
2070 | cR := 0; |
||
2071 | cG := 0; |
||
2072 | cB := 0; |
||
2073 | |||
2074 | for y:=0 to Height-1 do |
||
2075 | begin |
||
2076 | SrcP := Temp.ScanLine[y]; |
||
2077 | DestP := ScanLine[y]; |
||
2078 | |||
2079 | for x:=0 to Width-1 do |
||
2080 | begin |
||
2081 | case Temp.BitCount of |
||
2082 | 1 : begin |
||
2083 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
||
2084 | begin |
||
2085 | cR := rgbRed; |
||
2086 | cG := rgbGreen; |
||
2087 | cB := rgbBlue; |
||
2088 | end; |
||
2089 | end; |
||
2090 | 4 : begin |
||
2091 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
||
2092 | begin |
||
2093 | cR := rgbRed; |
||
2094 | cG := rgbGreen; |
||
2095 | cB := rgbBlue; |
||
2096 | end; |
||
2097 | end; |
||
2098 | 8 : begin |
||
2099 | with Temp.ColorTable[PByte(SrcP)^] do |
||
2100 | begin |
||
2101 | cR := rgbRed; |
||
2102 | cG := rgbGreen; |
||
2103 | cB := rgbBlue; |
||
2104 | end; |
||
2105 | Inc(PByte(SrcP)); |
||
2106 | end; |
||
2107 | 16: begin |
||
2108 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB); |
||
2109 | Inc(PWord(SrcP)); |
||
2110 | end; |
||
2111 | 24: begin |
||
2112 | with PBGR(SrcP)^ do |
||
2113 | begin |
||
2114 | cR := R; |
||
2115 | cG := G; |
||
2116 | cB := B; |
||
2117 | end; |
||
2118 | |||
2119 | Inc(PBGR(SrcP)); |
||
2120 | end; |
||
2121 | 32: begin |
||
2122 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB); |
||
2123 | Inc(PDWORD(SrcP)); |
||
2124 | end; |
||
2125 | end; |
||
2126 | |||
2127 | case BitCount of |
||
2128 | 16: begin |
||
2129 | PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
||
2130 | Inc(PWord(DestP)); |
||
2131 | end; |
||
2132 | 24: begin |
||
2133 | with PBGR(DestP)^ do |
||
2134 | begin |
||
2135 | R := cR; |
||
2136 | G := cG; |
||
2137 | B := cB; |
||
2138 | end; |
||
2139 | Inc(PBGR(DestP)); |
||
2140 | end; |
||
2141 | 32: begin |
||
2142 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
||
2143 | Inc(PDWORD(DestP)); |
||
2144 | end; |
||
2145 | end; |
||
2146 | end; |
||
2147 | end; |
||
2148 | end; |
||
2149 | |||
2150 | begin |
||
2151 | if Size=0 then exit; |
||
2152 | |||
2153 | Temp := TDIB.Create; |
||
2154 | try |
||
2155 | Temp.Assign(Self); |
||
2156 | SetSize(Temp.Width, Temp.Height, ABitCount); |
||
2157 | |||
2158 | if FImage=Temp.FImage then Exit; |
||
2159 | |||
2160 | if (Temp.BitCount<=8) and (BitCount<=8) then |
||
2161 | begin |
||
2162 | { The image is converted from the palette color image into the palette color image. } |
||
2163 | if Temp.BitCount<=BitCount then |
||
2164 | begin |
||
2165 | PaletteToPalette_Inc; |
||
2166 | end else |
||
2167 | begin |
||
2168 | case BitCount of |
||
2169 | 1: begin |
||
2170 | ColorTable[0] := RGBQuad(0, 0, 0); |
||
2171 | ColorTable[1] := RGBQuad(255, 255, 255); |
||
2172 | end; |
||
2173 | 4: CreateHalftonePalette(1, 2, 1); |
||
2174 | 8: CreateHalftonePalette(3, 3, 2); |
||
2175 | end; |
||
2176 | UpdatePalette; |
||
2177 | |||
2178 | Canvas.Draw(0, 0, Temp); |
||
2179 | end; |
||
2180 | end else |
||
2181 | if (Temp.BitCount<=8) and (BitCount>8) then |
||
2182 | begin |
||
2183 | { The image is converted from the palette color image into the rgb color image. } |
||
2184 | PaletteToRGB_or_RGBToRGB; |
||
2185 | end else |
||
2186 | if (Temp.BitCount>8) and (BitCount<=8) then |
||
2187 | begin |
||
2188 | { The image is converted from the rgb color image into the palette color image. } |
||
2189 | case BitCount of |
||
2190 | 1: begin |
||
2191 | ColorTable[0] := RGBQuad(0, 0, 0); |
||
2192 | ColorTable[1] := RGBQuad(255, 255, 255); |
||
2193 | end; |
||
2194 | 4: CreateHalftonePalette(1, 2, 1); |
||
2195 | 8: CreateHalftonePalette(3, 3, 2); |
||
2196 | end; |
||
2197 | UpdatePalette; |
||
2198 | |||
2199 | Canvas.Draw(0, 0, Temp); |
||
2200 | end else |
||
2201 | if (Temp.BitCount>8) and (BitCount>8) then |
||
2202 | begin |
||
2203 | { The image is converted from the rgb color image into the rgb color image. } |
||
2204 | PaletteToRGB_or_RGBToRGB; |
||
2205 | end; |
||
2206 | finally |
||
2207 | Temp.Free; |
||
2208 | end; |
||
2209 | end; |
||
2210 | |||
2211 | { Special effect } |
||
2212 | |||
2213 | procedure TDIB.StartProgress(const Name: string); |
||
2214 | begin |
||
2215 | FProgressName := Name; |
||
2216 | FProgressOld := 0; |
||
2217 | FProgressOldTime := GetTickCount; |
||
2218 | FProgressY := 0; |
||
2219 | FProgressOldY := 0; |
||
2220 | Progress(Self, psStarting, 0, False, Rect(0, 0, Width, Height), FProgressName); |
||
2221 | end; |
||
2222 | |||
2223 | procedure TDIB.EndProgress; |
||
2224 | begin |
||
2225 | Progress(Self, psEnding, 100, True, Rect(0, FProgressOldY, Width, Height), FProgressName); |
||
2226 | end; |
||
2227 | |||
2228 | procedure TDIB.UpdateProgress(PercentY: Integer); |
||
2229 | var |
||
2230 | Redraw: Boolean; |
||
2231 | Percent: DWORD; |
||
2232 | begin |
||
2233 | Redraw := (GetTickCount-FProgressOldTime>200) and (FProgressY-FProgressOldY>32) and |
||
2234 | (((Height div 3>Integer(FProgressY)) and (FProgressOldY=0)) or (FProgressOldY<>0)); |
||
2235 | |||
2236 | Percent := PercentY*100 div Height; |
||
2237 | |||
2238 | if (Percent<>FProgressOld) or (Redraw) then |
||
2239 | begin |
||
2240 | Progress(Self, psRunning, Percent, Redraw, |
||
2241 | Rect(0, FProgressOldY, Width, FProgressY), FProgressName); |
||
2242 | if Redraw then |
||
2243 | begin |
||
2244 | FProgressOldY := FProgressY; |
||
2245 | FProgressOldTime := GetTickCount; |
||
2246 | end; |
||
2247 | |||
2248 | FProgressOld := Percent; |
||
2249 | end; |
||
2250 | |||
2251 | Inc(FProgressY); |
||
2252 | end; |
||
2253 | |||
2254 | procedure TDIB.Blur(ABitCount: Integer; Radius: Integer); |
||
2255 | type |
||
2256 | TAve = record |
||
2257 | cR, cG, cB: DWORD; |
||
2258 | c: DWORD; |
||
2259 | end; |
||
2260 | TArrayAve = array[0..0] of TAve; |
||
2261 | |||
2262 | var |
||
2263 | Temp: TDIB; |
||
2264 | |||
2265 | procedure AddAverage(Y, XCount: Integer; var Ave: TArrayAve); |
||
2266 | var |
||
2267 | X: Integer; |
||
2268 | SrcP: Pointer; |
||
2269 | AveP: ^TAve; |
||
2270 | R, G, B: Byte; |
||
2271 | begin |
||
2272 | case Temp.BitCount of |
||
2273 | 1 : begin |
||
2274 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2275 | AveP := @Ave; |
||
2276 | for x:=0 to XCount-1 do |
||
2277 | begin |
||
2278 | with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do |
||
2279 | begin |
||
2280 | Inc(cR, rgbRed); |
||
2281 | Inc(cG, rgbGreen); |
||
2282 | Inc(cB, rgbBlue); |
||
2283 | Inc(c); |
||
2284 | end; |
||
2285 | Inc(AveP); |
||
2286 | end; |
||
2287 | end; |
||
2288 | 4 : begin |
||
2289 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2290 | AveP := @Ave; |
||
2291 | for x:=0 to XCount-1 do |
||
2292 | begin |
||
2293 | with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do |
||
2294 | begin |
||
2295 | Inc(cR, rgbRed); |
||
2296 | Inc(cG, rgbGreen); |
||
2297 | Inc(cB, rgbBlue); |
||
2298 | Inc(c); |
||
2299 | end; |
||
2300 | Inc(AveP); |
||
2301 | end; |
||
2302 | end; |
||
2303 | 8 : begin |
||
2304 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2305 | AveP := @Ave; |
||
2306 | for x:=0 to XCount-1 do |
||
2307 | begin |
||
2308 | with Temp.ColorTable[PByte(SrcP)^], AveP^ do |
||
2309 | begin |
||
2310 | Inc(cR, rgbRed); |
||
2311 | Inc(cG, rgbGreen); |
||
2312 | Inc(cB, rgbBlue); |
||
2313 | Inc(c); |
||
2314 | end; |
||
2315 | Inc(PByte(SrcP)); |
||
2316 | Inc(AveP); |
||
2317 | end; |
||
2318 | end; |
||
2319 | 16: begin |
||
2320 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2321 | AveP := @Ave; |
||
2322 | for x:=0 to XCount-1 do |
||
2323 | begin |
||
2324 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
||
2325 | with AveP^ do |
||
2326 | begin |
||
2327 | Inc(cR, R); |
||
2328 | Inc(cG, G); |
||
2329 | Inc(cB, B); |
||
2330 | Inc(c); |
||
2331 | end; |
||
2332 | Inc(PWord(SrcP)); |
||
2333 | Inc(AveP); |
||
2334 | end; |
||
2335 | end; |
||
2336 | 24: begin |
||
2337 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2338 | AveP := @Ave; |
||
2339 | for x:=0 to XCount-1 do |
||
2340 | begin |
||
2341 | with PBGR(SrcP)^, AveP^ do |
||
2342 | begin |
||
2343 | Inc(cR, R); |
||
2344 | Inc(cG, G); |
||
2345 | Inc(cB, B); |
||
2346 | Inc(c); |
||
2347 | end; |
||
2348 | Inc(PBGR(SrcP)); |
||
2349 | Inc(AveP); |
||
2350 | end; |
||
2351 | end; |
||
2352 | 32: begin |
||
2353 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2354 | AveP := @Ave; |
||
2355 | for x:=0 to XCount-1 do |
||
2356 | begin |
||
2357 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
||
2358 | with AveP^ do |
||
2359 | begin |
||
2360 | Inc(cR, R); |
||
2361 | Inc(cG, G); |
||
2362 | Inc(cB, B); |
||
2363 | Inc(c); |
||
2364 | end; |
||
2365 | Inc(PDWORD(SrcP)); |
||
2366 | Inc(AveP); |
||
2367 | end; |
||
2368 | end; |
||
2369 | end; |
||
2370 | end; |
||
2371 | |||
2372 | procedure DeleteAverage(Y, XCount: Integer; var Ave: TArrayAve); |
||
2373 | var |
||
2374 | X: Integer; |
||
2375 | SrcP: Pointer; |
||
2376 | AveP: ^TAve; |
||
2377 | R, G, B: Byte; |
||
2378 | begin |
||
2379 | case Temp.BitCount of |
||
2380 | 1 : begin |
||
2381 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2382 | AveP := @Ave; |
||
2383 | for x:=0 to XCount-1 do |
||
2384 | begin |
||
2385 | with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do |
||
2386 | begin |
||
2387 | Dec(cR, rgbRed); |
||
2388 | Dec(cG, rgbGreen); |
||
2389 | Dec(cB, rgbBlue); |
||
2390 | Dec(c); |
||
2391 | end; |
||
2392 | Inc(AveP); |
||
2393 | end; |
||
2394 | end; |
||
2395 | 4 : begin |
||
2396 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2397 | AveP := @Ave; |
||
2398 | for x:=0 to XCount-1 do |
||
2399 | begin |
||
2400 | with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do |
||
2401 | begin |
||
2402 | Dec(cR, rgbRed); |
||
2403 | Dec(cG, rgbGreen); |
||
2404 | Dec(cB, rgbBlue); |
||
2405 | Dec(c); |
||
2406 | end; |
||
2407 | Inc(AveP); |
||
2408 | end; |
||
2409 | end; |
||
2410 | 8 : begin |
||
2411 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2412 | AveP := @Ave; |
||
2413 | for x:=0 to XCount-1 do |
||
2414 | begin |
||
2415 | with Temp.ColorTable[PByte(SrcP)^], AveP^ do |
||
2416 | begin |
||
2417 | Dec(cR, rgbRed); |
||
2418 | Dec(cG, rgbGreen); |
||
2419 | Dec(cB, rgbBlue); |
||
2420 | Dec(c); |
||
2421 | end; |
||
2422 | Inc(PByte(SrcP)); |
||
2423 | Inc(AveP); |
||
2424 | end; |
||
2425 | end; |
||
2426 | 16: begin |
||
2427 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2428 | AveP := @Ave; |
||
2429 | for x:=0 to XCount-1 do |
||
2430 | begin |
||
2431 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
||
2432 | with AveP^ do |
||
2433 | begin |
||
2434 | Dec(cR, R); |
||
2435 | Dec(cG, G); |
||
2436 | Dec(cB, B); |
||
2437 | Dec(c); |
||
2438 | end; |
||
2439 | Inc(PWord(SrcP)); |
||
2440 | Inc(AveP); |
||
2441 | end; |
||
2442 | end; |
||
2443 | 24: begin |
||
2444 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2445 | AveP := @Ave; |
||
2446 | for x:=0 to XCount-1 do |
||
2447 | begin |
||
2448 | with PBGR(SrcP)^, AveP^ do |
||
2449 | begin |
||
2450 | Dec(cR, R); |
||
2451 | Dec(cG, G); |
||
2452 | Dec(cB, B); |
||
2453 | Dec(c); |
||
2454 | end; |
||
2455 | Inc(PBGR(SrcP)); |
||
2456 | Inc(AveP); |
||
2457 | end; |
||
2458 | end; |
||
2459 | 32: begin |
||
2460 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
||
2461 | AveP := @Ave; |
||
2462 | for x:=0 to XCount-1 do |
||
2463 | begin |
||
2464 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
||
2465 | with AveP^ do |
||
2466 | begin |
||
2467 | Dec(cR, R); |
||
2468 | Dec(cG, G); |
||
2469 | Dec(cB, B); |
||
2470 | Dec(c); |
||
2471 | end; |
||
2472 | Inc(PDWORD(SrcP)); |
||
2473 | Inc(AveP); |
||
2474 | end; |
||
2475 | end; |
||
2476 | end; |
||
2477 | end; |
||
2478 | |||
2479 | procedure Blur_Radius_Other; |
||
2480 | var |
||
2481 | FirstX, LastX, FirstX2, LastX2, FirstY, LastY: Integer; |
||
2482 | x, y, x2, y2, jx, jy: Integer; |
||
2483 | Ave: TAve; |
||
2484 | AveX: ^TArrayAve; |
||
2485 | DestP: Pointer; |
||
2486 | P: PByte; |
||
2487 | begin |
||
2488 | GetMem(AveX, Width*SizeOf(TAve)); |
||
2489 | try |
||
2490 | FillChar(AveX^, Width*SizeOf(TAve), 0); |
||
2491 | |||
2492 | FirstX2 := -1; |
||
2493 | LastX2 := -1; |
||
2494 | FirstY := -1; |
||
2495 | LastY := -1; |
||
2496 | |||
2497 | x := 0; |
||
2498 | for x2:=-Radius to Radius do |
||
2499 | begin |
||
2500 | jx := x+x2; |
||
2501 | if (jx>=0) and (jx<Width) then |
||
2502 | begin |
||
2503 | if FirstX2=-1 then FirstX2 := jx; |
||
2504 | if LastX2<jx then LastX2 := jx; |
||
2505 | end; |
||
2506 | end; |
||
2507 | |||
2508 | y := 0; |
||
2509 | for y2:=-Radius to Radius do |
||
2510 | begin |
||
2511 | jy := y+y2; |
||
2512 | if (jy>=0) and (jy<Height) then |
||
2513 | begin |
||
2514 | if FirstY=-1 then FirstY := jy; |
||
2515 | if LastY<jy then LastY := jy; |
||
2516 | end; |
||
2517 | end; |
||
2518 | |||
2519 | for y:=FirstY to LastY do |
||
2520 | AddAverage(y, Temp.Width, AveX^); |
||
2521 | |||
2522 | for y:=0 to Height-1 do |
||
2523 | begin |
||
2524 | DestP := ScanLine[y]; |
||
2525 | |||
2526 | { The average is updated. } |
||
2527 | if y-FirstY=Radius+1 then |
||
2528 | begin |
||
2529 | DeleteAverage(FirstY, Temp.Width, AveX^); |
||
2530 | Inc(FirstY); |
||
2531 | end; |
||
2532 | |||
2533 | if LastY-y=Radius-1 then |
||
2534 | begin |
||
2535 | Inc(LastY); if LastY>=Height then LastY := Height-1; |
||
2536 | AddAverage(LastY, Temp.Width, AveX^); |
||
2537 | end; |
||
2538 | |||
2539 | { The average is calculated again. } |
||
2540 | FirstX := FirstX2; |
||
2541 | LastX := LastX2; |
||
2542 | |||
2543 | FillChar(Ave, SizeOf(Ave), 0); |
||
2544 | for x:=FirstX to LastX do |
||
2545 | with AveX[x] do |
||
2546 | begin |
||
2547 | Inc(Ave.cR, cR); |
||
2548 | Inc(Ave.cG, cG); |
||
2549 | Inc(Ave.cB, cB); |
||
2550 | Inc(Ave.c, c); |
||
2551 | end; |
||
2552 | |||
2553 | for x:=0 to Width-1 do |
||
2554 | begin |
||
2555 | { The average is updated. } |
||
2556 | if x-FirstX=Radius+1 then |
||
2557 | begin |
||
2558 | with AveX[FirstX] do |
||
2559 | begin |
||
2560 | Dec(Ave.cR, cR); |
||
2561 | Dec(Ave.cG, cG); |
||
2562 | Dec(Ave.cB, cB); |
||
2563 | Dec(Ave.c, c); |
||
2564 | end; |
||
2565 | Inc(FirstX); |
||
2566 | end; |
||
2567 | |||
2568 | if LastX-x=Radius-1 then |
||
2569 | begin |
||
2570 | Inc(LastX); if LastX>=Width then LastX := Width-1; |
||
2571 | with AveX[LastX] do |
||
2572 | begin |
||
2573 | Inc(Ave.cR, cR); |
||
2574 | Inc(Ave.cG, cG); |
||
2575 | Inc(Ave.cB, cB); |
||
2576 | Inc(Ave.c, c); |
||
2577 | end; |
||
2578 | end; |
||
2579 | |||
2580 | { The average is written. } |
||
2581 | case BitCount of |
||
2582 | 1 : begin |
||
2583 | P := @PArrayByte(DestP)[X shr 3]; |
||
2584 | with Ave do |
||
2585 | P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(((cR+cG+cB) div c) div 3>127)) shl Shift1[X and 7]); |
||
2586 | end; |
||
2587 | 4 : begin |
||
2588 | P := @PArrayByte(DestP)[X shr 1]; |
||
2589 | with Ave do |
||
2590 | P^ := (P^ and Mask4n[X and 1]) or (((((cR+cG+cB) div c) div 3) shr 4) shl Shift4[X and 1]); |
||
2591 | end; |
||
2592 | 8 : begin |
||
2593 | with Ave do |
||
2594 | PByte(DestP)^ := ((cR+cG+cB) div c) div 3; |
||
2595 | Inc(PByte(DestP)); |
||
2596 | end; |
||
2597 | 16: begin |
||
2598 | with Ave do |
||
2599 | PWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c); |
||
2600 | Inc(PWORD(DestP)); |
||
2601 | end; |
||
2602 | 24: begin |
||
2603 | with PBGR(DestP)^, Ave do |
||
2604 | begin |
||
2605 | R := cR div c; |
||
2606 | G := cG div c; |
||
2607 | B := cB div c; |
||
2608 | end; |
||
2609 | Inc(PBGR(DestP)); |
||
2610 | end; |
||
2611 | 32: begin |
||
2612 | with Ave do |
||
2613 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c); |
||
2614 | Inc(PDWORD(DestP)); |
||
2615 | end; |
||
2616 | end; |
||
2617 | end; |
||
2618 | |||
2619 | UpdateProgress(y); |
||
2620 | end; |
||
2621 | finally |
||
2622 | FreeMem(AveX); |
||
2623 | end; |
||
2624 | end; |
||
2625 | |||
2626 | var |
||
2627 | i, j: Integer; |
||
2628 | begin |
||
2629 | if Empty or (Radius=0) then Exit; |
||
2630 | |||
2631 | Radius := Abs(Radius); |
||
2632 | |||
2633 | StartProgress('Blur'); |
||
2634 | try |
||
2635 | Temp := TDIB.Create; |
||
2636 | try |
||
2637 | Temp.Assign(Self); |
||
2638 | SetSize(Width, Height, ABitCount); |
||
2639 | |||
2640 | if ABitCount<=8 then |
||
2641 | begin |
||
2642 | FillChar(ColorTable, SizeOf(ColorTable), 0); |
||
2643 | for i:=0 to (1 shl ABitCount)-1 do |
||
2644 | begin |
||
2645 | j := i * (1 shl (8-ABitCount)); |
||
2646 | j := j or (j shr ABitCount); |
||
2647 | ColorTable[i] := RGBQuad(j, j, j); |
||
2648 | end; |
||
2649 | UpdatePalette; |
||
2650 | end; |
||
2651 | |||
2652 | Blur_Radius_Other; |
||
2653 | finally |
||
2654 | Temp.Free; |
||
2655 | end; |
||
2656 | finally |
||
2657 | EndProgress; |
||
2658 | end; |
||
2659 | end; |
||
2660 | |||
2661 | procedure TDIB.Greyscale(ABitCount: Integer); |
||
2662 | var |
||
2663 | YTblR, YTblG, YTblB: array[0..255] of Byte; |
||
2664 | i, j, x, y: Integer; |
||
2665 | c: DWORD; |
||
2666 | R, G, B: Byte; |
||
2667 | Temp: TDIB; |
||
2668 | DestP, SrcP: Pointer; |
||
2669 | P: PByte; |
||
2670 | begin |
||
2671 | if Empty then exit; |
||
2672 | |||
2673 | Temp := TDIB.Create; |
||
2674 | try |
||
2675 | Temp.Assign(Self); |
||
2676 | SetSize(Width, Height, ABitCount); |
||
2677 | |||
2678 | if ABitCount<=8 then |
||
2679 | begin |
||
2680 | FillChar(ColorTable, SizeOf(ColorTable), 0); |
||
2681 | for i:=0 to (1 shl ABitCount)-1 do |
||
2682 | begin |
||
2683 | j := i * (1 shl (8-ABitCount)); |
||
2684 | j := j or (j shr ABitCount); |
||
2685 | ColorTable[i] := RGBQuad(j, j, j); |
||
2686 | end; |
||
2687 | UpdatePalette; |
||
2688 | end; |
||
2689 | |||
2690 | for i:=0 to 255 do |
||
2691 | begin |
||
2692 | YTblR[i] := Trunc(0.3588*i); |
||
2693 | YTblG[i] := Trunc(0.4020*i); |
||
2694 | YTblB[i] := Trunc(0.2392*i); |
||
2695 | end; |
||
2696 | |||
2697 | c := 0; |
||
2698 | |||
2699 | StartProgress('Greyscale'); |
||
2700 | try |
||
2701 | for y:=0 to Height-1 do |
||
2702 | begin |
||
2703 | DestP := ScanLine[y]; |
||
2704 | SrcP := Temp.ScanLine[y]; |
||
2705 | |||
2706 | for x:=0 to Width-1 do |
||
2707 | begin |
||
2708 | case Temp.BitCount of |
||
2709 | 1 : begin |
||
2710 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
||
2711 | c := YTblR[rgbRed]+YTblG[rgbGreen]+YTblB[rgbBlue]; |
||
2712 | end; |
||
2713 | 4 : begin |
||
2714 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
||
2715 | c := YTblR[rgbRed]+YTblG[rgbGreen]+YTblB[rgbBlue]; |
||
2716 | end; |
||
2717 | 8 : begin |
||
2718 | with Temp.ColorTable[PByte(SrcP)^] do |
||
2719 | c := YTblR[rgbRed]+YTblG[rgbGreen]+YTblB[rgbBlue]; |
||
2720 | Inc(PByte(SrcP)); |
||
2721 | end; |
||
2722 | 16: begin |
||
2723 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
||
2724 | c := YTblR[R]+YTblR[G]+YTblR[B]; |
||
2725 | Inc(PWord(SrcP)); |
||
2726 | end; |
||
2727 | 24: begin |
||
2728 | with PBGR(SrcP)^ do |
||
2729 | c := YTblR[R]+YTblG[G]+YTblB[B]; |
||
2730 | Inc(PBGR(SrcP)); |
||
2731 | end; |
||
2732 | 32: begin |
||
2733 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
||
2734 | c := YTblR[R]+YTblR[G]+YTblR[B]; |
||
2735 | Inc(PDWORD(SrcP)); |
||
2736 | end; |
||
2737 | end; |
||
2738 | |||
2739 | case BitCount of |
||
2740 | 1 : begin |
||
2741 | P := @PArrayByte(DestP)[X shr 3]; |
||
2742 | P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(c>127)) shl Shift1[X and 7]); |
||
2743 | end; |
||
2744 | 4 : begin |
||
2745 | P := @PArrayByte(DestP)[X shr 1]; |
||
2746 | P^ := (P^ and Mask4n[X and 1]) or ((c shr 4) shl Shift4[X and 1]); |
||
2747 | end; |
||
2748 | 8 : begin |
||
2749 | PByte(DestP)^ := c; |
||
2750 | Inc(PByte(DestP)); |
||
2751 | end; |
||
2752 | 16: begin |
||
2753 | PWord(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
||
2754 | Inc(PWord(DestP)); |
||
2755 | end; |
||
2756 | 24: begin |
||
2757 | with PBGR(DestP)^ do |
||
2758 | begin |
||
2759 | R := c; |
||
2760 | G := c; |
||
2761 | B := c; |
||
2762 | end; |
||
2763 | Inc(PBGR(DestP)); |
||
2764 | end; |
||
2765 | 32: begin |
||
2766 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
||
2767 | Inc(PDWORD(DestP)); |
||
2768 | end; |
||
2769 | end; |
||
2770 | end; |
||
2771 | |||
2772 | UpdateProgress(y); |
||
2773 | end; |
||
2774 | finally |
||
2775 | EndProgress; |
||
2776 | end; |
||
2777 | finally |
||
2778 | Temp.Free; |
||
2779 | end; |
||
2780 | end; |
||
2781 | |||
2782 | procedure TDIB.Mirror(MirrorX, MirrorY: Boolean); |
||
2783 | var |
||
2784 | x, y, Width2, c: Integer; |
||
2785 | P1, P2, TempBuf: Pointer; |
||
2786 | begin |
||
2787 | if Empty then exit; |
||
2788 | if (not MirrorX) and (not MirrorY) then Exit; |
||
2789 | |||
2790 | if (not MirrorX) and (MirrorY) then |
||
2791 | begin |
||
2792 | GetMem(TempBuf, WidthBytes); |
||
2793 | try |
||
2794 | StartProgress('Mirror'); |
||
2795 | try |
||
2796 | for y:=0 to Height shr 1-1 do |
||
2797 | begin |
||
2798 | P1 := ScanLine[y]; |
||
2799 | P2 := ScanLine[Height-y-1]; |
||
2800 | |||
2801 | Move(P1^, TempBuf^, WidthBytes); |
||
2802 | Move(P2^, P1^, WidthBytes); |
||
2803 | Move(TempBuf^, P2^, WidthBytes); |
||
2804 | |||
2805 | UpdateProgress(y*2); |
||
2806 | end; |
||
2807 | finally |
||
2808 | EndProgress; |
||
2809 | end; |
||
2810 | finally |
||
2811 | FreeMem(TempBuf, WidthBytes); |
||
2812 | end; |
||
2813 | end else if (MirrorX) and (not MirrorY) then |
||
2814 | begin |
||
2815 | Width2 := Width shr 1; |
||
2816 | |||
2817 | StartProgress('Mirror'); |
||
2818 | try |
||
2819 | for y:=0 to Height-1 do |
||
2820 | begin |
||
2821 | P1 := ScanLine[y]; |
||
2822 | |||
2823 | case BitCount of |
||
2824 | 1 : begin |
||
2825 | for x:=0 to Width2-1 do |
||
2826 | begin |
||
2827 | c := Pixels[x, y]; |
||
2828 | Pixels[x, y] := Pixels[Width-x-1, y]; |
||
2829 | Pixels[Width-x-1, y] := c; |
||
2830 | end; |
||
2831 | end; |
||
2832 | 4 : begin |
||
2833 | for x:=0 to Width2-1 do |
||
2834 | begin |
||
2835 | c := Pixels[x, y]; |
||
2836 | Pixels[x, y] := Pixels[Width-x-1, y]; |
||
2837 | Pixels[Width-x-1, y] := c; |
||
2838 | end; |
||
2839 | end; |
||
2840 | 8 : begin |
||
2841 | P2 := Pointer(Integer(P1)+Width-1); |
||
2842 | for x:=0 to Width2-1 do |
||
2843 | begin |
||
2844 | PByte(@c)^ := PByte(P1)^; |
||
2845 | PByte(P1)^ := PByte(P2)^; |
||
2846 | PByte(P2)^ := PByte(@c)^; |
||
2847 | Inc(PByte(P1)); |
||
2848 | Dec(PByte(P2)); |
||
2849 | end; |
||
2850 | end; |
||
2851 | 16: begin |
||
2852 | P2 := Pointer(Integer(P1)+(Width-1)*2); |
||
2853 | for x:=0 to Width2-1 do |
||
2854 | begin |
||
2855 | PWord(@c)^ := PWord(P1)^; |
||
2856 | PWord(P1)^ := PWord(P2)^; |
||
2857 | PWord(P2)^ := PWord(@c)^; |
||
2858 | Inc(PWord(P1)); |
||
2859 | Dec(PWord(P2)); |
||
2860 | end; |
||
2861 | end; |
||
2862 | 24: begin |
||
2863 | P2 := Pointer(Integer(P1)+(Width-1)*3); |
||
2864 | for x:=0 to Width2-1 do |
||
2865 | begin |
||
2866 | PBGR(@c)^ := PBGR(P1)^; |
||
2867 | PBGR(P1)^ := PBGR(P2)^; |
||
2868 | PBGR(P2)^ := PBGR(@c)^; |
||
2869 | Inc(PBGR(P1)); |
||
2870 | Dec(PBGR(P2)); |
||
2871 | end; |
||
2872 | end; |
||
2873 | 32: begin |
||
2874 | P2 := Pointer(Integer(P1)+(Width-1)*4); |
||
2875 | for x:=0 to Width2-1 do |
||
2876 | begin |
||
2877 | PDWORD(@c)^ := PDWORD(P1)^; |
||
2878 | PDWORD(P1)^ := PDWORD(P2)^; |
||
2879 | PDWORD(P2)^ := PDWORD(@c)^; |
||
2880 | Inc(PDWORD(P1)); |
||
2881 | Dec(PDWORD(P2)); |
||
2882 | end; |
||
2883 | end; |
||
2884 | end; |
||
2885 | |||
2886 | UpdateProgress(y); |
||
2887 | end; |
||
2888 | finally |
||
2889 | EndProgress; |
||
2890 | end; |
||
2891 | end else if (MirrorX) and (MirrorY) then |
||
2892 | begin |
||
2893 | StartProgress('Mirror'); |
||
2894 | try |
||
2895 | for y:=0 to Height shr 1-1 do |
||
2896 | begin |
||
2897 | P1 := ScanLine[y]; |
||
2898 | P2 := ScanLine[Height-y-1]; |
||
2899 | |||
2900 | case BitCount of |
||
2901 | 1 : begin |
||
2902 | for x:=0 to Width-1 do |
||
2903 | begin |
||
2904 | c := Pixels[x, y]; |
||
2905 | Pixels[x, y] := Pixels[Width-x-1, Height-y-1]; |
||
2906 | Pixels[Width-x-1, Height-y-1] := c; |
||
2907 | end; |
||
2908 | end; |
||
2909 | 4 : begin |
||
2910 | for x:=0 to Width-1 do |
||
2911 | begin |
||
2912 | c := Pixels[x, y]; |
||
2913 | Pixels[x, y] := Pixels[Width-x-1, Height-y-1]; |
||
2914 | Pixels[Width-x-1, Height-y-1] := c; |
||
2915 | end; |
||
2916 | end; |
||
2917 | 8 : begin |
||
2918 | P2 := Pointer(Integer(P2)+Width-1); |
||
2919 | for x:=0 to Width-1 do |
||
2920 | begin |
||
2921 | PByte(@c)^ := PByte(P1)^; |
||
2922 | PByte(P1)^ := PByte(P2)^; |
||
2923 | PByte(P2)^ := PByte(@c)^; |
||
2924 | Inc(PByte(P1)); |
||
2925 | Dec(PByte(P2)); |
||
2926 | end; |
||
2927 | end; |
||
2928 | 16: begin |
||
2929 | P2 := Pointer(Integer(P2)+(Width-1)*2); |
||
2930 | for x:=0 to Width-1 do |
||
2931 | begin |
||
2932 | PWord(@c)^ := PWord(P1)^; |
||
2933 | PWord(P1)^ := PWord(P2)^; |
||
2934 | PWord(P2)^ := PWord(@c)^; |
||
2935 | Inc(PWord(P1)); |
||
2936 | Dec(PWord(P2)); |
||
2937 | end; |
||
2938 | end; |
||
2939 | 24: begin |
||
2940 | P2 := Pointer(Integer(P2)+(Width-1)*3); |
||
2941 | for x:=0 to Width-1 do |
||
2942 | begin |
||
2943 | PBGR(@c)^ := PBGR(P1)^; |
||
2944 | PBGR(P1)^ := PBGR(P2)^; |
||
2945 | PBGR(P2)^ := PBGR(@c)^; |
||
2946 | Inc(PBGR(P1)); |
||
2947 | Dec(PBGR(P2)); |
||
2948 | end; |
||
2949 | end; |
||
2950 | 32: begin |
||
2951 | P2 := Pointer(Integer(P2)+(Width-1)*4); |
||
2952 | for x:=0 to Width-1 do |
||
2953 | begin |
||
2954 | PDWORD(@c)^ := PDWORD(P1)^; |
||
2955 | PDWORD(P1)^ := PDWORD(P2)^; |
||
2956 | PDWORD(P2)^ := PDWORD(@c)^; |
||
2957 | Inc(PDWORD(P1)); |
||
2958 | Dec(PDWORD(P2)); |
||
2959 | end; |
||
2960 | end; |
||
2961 | end; |
||
2962 | |||
2963 | UpdateProgress(y*2); |
||
2964 | end; |
||
2965 | finally |
||
2966 | EndProgress; |
||
2967 | end; |
||
2968 | end; |
||
2969 | end; |
||
2970 | |||
2971 | procedure TDIB.Negative; |
||
2972 | var |
||
2973 | i, i2: Integer; |
||
2974 | P: Pointer; |
||
2975 | begin |
||
2976 | if Empty then exit; |
||
2977 | |||
2978 | if BitCount<=8 then |
||
2979 | begin |
||
2980 | for i:=0 to 255 do |
||
2981 | with ColorTable[i] do |
||
2982 | begin |
||
2983 | rgbRed := 255-rgbRed; |
||
2984 | rgbGreen := 255-rgbGreen; |
||
2985 | rgbBlue := 255-rgbBlue; |
||
2986 | end; |
||
2987 | UpdatePalette; |
||
2988 | end else |
||
2989 | begin |
||
2990 | P := PBits; |
||
2991 | i2 := Size; |
||
2992 | asm |
||
2993 | mov ecx,i2 |
||
2994 | mov eax,P |
||
2995 | mov edx,ecx |
||
2996 | |||
2997 | { Unit of DWORD. } |
||
2998 | @@qword_skip: |
||
2999 | shr ecx,2 |
||
3000 | jz @@dword_skip |
||
3001 | |||
3002 | dec ecx |
||
3003 | @@dword_loop: |
||
3004 | not dword ptr [eax+ecx*4] |
||
3005 | dec ecx |
||
3006 | jnl @@dword_loop |
||
3007 | |||
3008 | mov ecx,edx |
||
3009 | shr ecx,2 |
||
3010 | add eax,ecx*4 |
||
3011 | |||
3012 | { Unit of Byte. } |
||
3013 | @@dword_skip: |
||
3014 | mov ecx,edx |
||
3015 | and ecx,3 |
||
3016 | jz @@byte_skip |
||
3017 | |||
3018 | dec ecx |
||
3019 | @@loop_byte: |
||
3020 | not byte ptr [eax+ecx] |
||
3021 | dec ecx |
||
3022 | jnl @@loop_byte |
||
3023 | |||
3024 | @@byte_skip: |
||
3025 | end; |
||
3026 | end; |
||
3027 | end; |
||
3028 | |||
3029 | { TCustomDXDIB } |
||
3030 | |||
3031 | constructor TCustomDXDIB.Create(AOnwer: TComponent); |
||
3032 | begin |
||
3033 | inherited Create(AOnwer); |
||
3034 | FDIB := TDIB.Create; |
||
3035 | end; |
||
3036 | |||
3037 | destructor TCustomDXDIB.Destroy; |
||
3038 | begin |
||
3039 | FDIB.Free; |
||
3040 | inherited Destroy; |
||
3041 | end; |
||
3042 | |||
3043 | procedure TCustomDXDIB.SetDIB(Value: TDIB); |
||
3044 | begin |
||
3045 | FDIB.Assign(Value); |
||
3046 | end; |
||
3047 | |||
3048 | { TCustomDXPaintBox } |
||
3049 | |||
3050 | constructor TCustomDXPaintBox.Create(AOwner: TComponent); |
||
3051 | begin |
||
3052 | inherited Create(AOwner); |
||
3053 | FDIB := TDIB.Create; |
||
3054 | |||
3055 | ControlStyle := ControlStyle + [csReplicatable]; |
||
3056 | Height := 105; |
||
3057 | Width := 105; |
||
3058 | end; |
||
3059 | |||
3060 | destructor TCustomDXPaintBox.Destroy; |
||
3061 | begin |
||
3062 | FDIB.Free; |
||
3063 | inherited Destroy; |
||
3064 | end; |
||
3065 | |||
3066 | function TCustomDXPaintBox.GetPalette: HPALETTE; |
||
3067 | begin |
||
3068 | Result := FDIB.Palette; |
||
3069 | end; |
||
3070 | |||
3071 | procedure TCustomDXPaintBox.Paint; |
||
3072 | |||
3073 | procedure Draw2(Width, Height: Integer); |
||
3074 | begin |
||
3075 | if (Width<>FDIB.Width) or (Height<>FDIB.Height) then |
||
3076 | begin |
||
3077 | if FCenter then |
||
3078 | begin |
||
3079 | inherited Canvas.StretchDraw(Bounds(-(Width-ClientWidth) div 2, |
||
3080 | -(Height-ClientHeight) div 2, Width, Height), FDIB); |
||
3081 | end else |
||
3082 | begin |
||
3083 | inherited Canvas.StretchDraw(Bounds(0, 0, Width, Height), FDIB); |
||
3084 | end; |
||
3085 | end else |
||
3086 | begin |
||
3087 | if FCenter then |
||
3088 | begin |
||
3089 | inherited Canvas.Draw(-(Width-ClientWidth) div 2, -(Height-ClientHeight) div 2, |
||
3090 | FDIB); |
||
3091 | end else |
||
3092 | begin |
||
3093 | inherited Canvas.Draw(0, 0, FDIB); |
||
3094 | end; |
||
3095 | end; |
||
3096 | end; |
||
3097 | |||
3098 | var |
||
3099 | r, r2: Single; |
||
3100 | ViewWidth2, ViewHeight2: Integer; |
||
3101 | begin |
||
3102 | inherited Paint; |
||
3103 | |||
3104 | with inherited Canvas do |
||
3105 | begin |
||
3106 | if (csDesigning in ComponentState) then |
||
3107 | begin |
||
3108 | Pen.Style := psDash; |
||
3109 | Brush.Style := bsClear; |
||
3110 | Rectangle(0, 0, Width, Height); |
||
3111 | end; |
||
3112 | |||
3113 | if FDIB.Empty then Exit; |
||
3114 | |||
3115 | if (FViewWidth>0) or (FViewHeight>0) then |
||
3116 | begin |
||
3117 | ViewWidth2 := FViewWidth; |
||
3118 | if ViewWidth2=0 then ViewWidth2 := FDIB.Width; |
||
3119 | ViewHeight2 := FViewHeight; |
||
3120 | if ViewHeight2=0 then ViewHeight2 := FDIB.Height; |
||
3121 | |||
3122 | if FAutoStretch then |
||
3123 | begin |
||
3124 | if (ClientWidth<ViewWidth2) or (ClientHeight<ViewHeight2) then |
||
3125 | begin |
||
3126 | r := ViewWidth2/ClientWidth; |
||
3127 | r2 := ViewHeight2/ClientHeight; |
||
3128 | if r>r2 then |
||
3129 | r := r2; |
||
3130 | Draw2(Round(r*ClientWidth), Round(r*ClientHeight)); |
||
3131 | end else |
||
3132 | Draw2(ViewWidth2, ViewHeight2); |
||
3133 | end else |
||
3134 | Draw2(ViewWidth2, ViewHeight2); |
||
3135 | end else |
||
3136 | begin |
||
3137 | if FAutoStretch then |
||
3138 | begin |
||
3139 | if (FDIB.Width>ClientWidth) or (FDIB.Height>ClientHeight) then |
||
3140 | begin |
||
3141 | r := ClientWidth/FDIB.Width; |
||
3142 | r2 := ClientHeight/FDIB.Height; |
||
3143 | if r>r2 then |
||
3144 | r := r2; |
||
3145 | Draw2(Round(r*FDIB.Width), Round(r*FDIB.Height)); |
||
3146 | end else |
||
3147 | Draw2(FDIB.Width, FDIB.Height); |
||
3148 | end else |
||
3149 | if FStretch then |
||
3150 | begin |
||
3151 | if FKeepAspect then |
||
3152 | begin |
||
3153 | r := ClientWidth/FDIB.Width; |
||
3154 | r2 := ClientHeight/FDIB.Height; |
||
3155 | if r>r2 then |
||
3156 | r := r2; |
||
3157 | Draw2(Round(r*FDIB.Width), Round(r*FDIB.Height)); |
||
3158 | end else |
||
3159 | Draw2(ClientWidth, ClientHeight); |
||
3160 | end else |
||
3161 | Draw2(FDIB.Width, FDIB.Height); |
||
3162 | end; |
||
3163 | end; |
||
3164 | end; |
||
3165 | |||
3166 | procedure TCustomDXPaintBox.SetAutoStretch(Value: Boolean); |
||
3167 | begin |
||
3168 | if FAutoStretch<>Value then |
||
3169 | begin |
||
3170 | FAutoStretch := Value; |
||
3171 | Invalidate; |
||
3172 | end; |
||
3173 | end; |
||
3174 | |||
3175 | procedure TCustomDXPaintBox.SetCenter(Value: Boolean); |
||
3176 | begin |
||
3177 | if FCenter<>Value then |
||
3178 | begin |
||
3179 | FCenter := Value; |
||
3180 | Invalidate; |
||
3181 | end; |
||
3182 | end; |
||
3183 | |||
3184 | procedure TCustomDXPaintBox.SetDIB(Value: TDIB); |
||
3185 | begin |
||
3186 | if FDIB<>Value then |
||
3187 | begin |
||
3188 | FDIB.Assign(Value); |
||
3189 | Invalidate; |
||
3190 | end; |
||
3191 | end; |
||
3192 | |||
3193 | procedure TCustomDXPaintBox.SetKeepAspect(Value: Boolean); |
||
3194 | begin |
||
3195 | if Value<>FKeepAspect then |
||
3196 | begin |
||
3197 | FKeepAspect := Value; |
||
3198 | Invalidate; |
||
3199 | end; |
||
3200 | end; |
||
3201 | |||
3202 | procedure TCustomDXPaintBox.SetStretch(Value: Boolean); |
||
3203 | begin |
||
3204 | if Value<>FStretch then |
||
3205 | begin |
||
3206 | FStretch := Value; |
||
3207 | Invalidate; |
||
3208 | end; |
||
3209 | end; |
||
3210 | |||
3211 | procedure TCustomDXPaintBox.SetViewWidth(Value: Integer); |
||
3212 | begin |
||
3213 | if Value<0 then Value := 0; |
||
3214 | if Value<>FViewWidth then |
||
3215 | begin |
||
3216 | FViewWidth := Value; |
||
3217 | Invalidate; |
||
3218 | end; |
||
3219 | end; |
||
3220 | |||
3221 | procedure TCustomDXPaintBox.SetViewHeight(Value: Integer); |
||
3222 | begin |
||
3223 | if Value<0 then Value := 0; |
||
3224 | if Value<>FViewHeight then |
||
3225 | begin |
||
3226 | FViewHeight := Value; |
||
3227 | Invalidate; |
||
3228 | end; |
||
3229 | end; |
||
3230 | |||
3231 | initialization |
||
3232 | TPicture.RegisterClipBoardFormat(CF_DIB, TDIB); |
||
3233 | TPicture.RegisterFileFormat('dib', 'Device Independent Bitmap', TDIB); |
||
3234 | finalization |
||
3235 | TPicture.UnRegisterGraphicClass(TDIB); |
||
3236 | |||
3237 | FEmptyDIBImage.Free; |
||
3238 | FPaletteManager.Free; |
||
3239 | end. |