source: branches/2.20_branch/Sibyl/SPCC/GRAPHICS.PAS

Last change on this file was 7, checked in by RBRi, 19 years ago

+ sibyl staff
  • Property svn:eol-style set to native
File size: 138.1 KB
Line 
1{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2 º º
3 º Sibyl Portable Component Classes º
4 º º
5 º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
6 º º
7 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
8
9Unit Graphics;
10
11Interface
12
13{$IFDEF OS2}
14Uses PmWin,PmGpi,PmBitmap,PmDev,Os2Def,BseDos;
15{$ENDIF}
16
17{$IFDEF Win95}
18Uses WinNt,WinDef,WinGDI,WinUser,WinBase;
19{$ENDIF}
20
21Uses Dos,SysUtils,Classes,Forms;
22
23
24Type
25 EInvalidBitmap=Class(Exception);
26 EInvalidIcon=Class(Exception);
27 EInvalidCursor=Class(Exception);
28 EInvalidPictureFormat=Class(Exception);
29
30Type
31 TMetaFile=Class;
32
33 TMetafileCanvas=Class(TCanvas)
34 Protected
35 FMetafile:TMetafile;
36 Public
37 Constructor Create(AMetafile: TMetafile);Virtual;
38 Destructor Destroy;Override;
39 End;
40
41 TMetafile=Class(TGraphic)
42 Protected
43 FDeviceHandle:LongWord;
44 FHandle:LongWord;
45 FMetaFileCanvas:TMetaFileCanvas;
46 Protected
47 Procedure GetOriginalRect(Var Rect: RECTL);
48 Function GetEmpty: Boolean;Override;
49 Function GetHeight:LongInt;Override;
50 Function GetWidth:LongInt;Override;
51 Procedure SetHeight(Value:LongInt);Override;
52 Procedure SetWidth(Value:LongInt);Override;
53 Function GetHandle:LongWord;Override;
54 Function GetCanvas:TCanvas;Override;
55 Function GetSize:LongInt;Override;
56 Procedure PaletteChanged;Override;
57 Procedure CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);Override;
58 Public
59 Function LoadFromClipBoard:Boolean;
60 Procedure Assign(Source:TPersistent);Override;
61 Function CreateMask(Color:TColor):TGraphic;Override;
62 Procedure PartialDraw(Canvas:TCanvas;Const Src,Dest:TRect);Override;
63 Procedure Draw(ACanvas: TCanvas;Const Rect: TRect);Override;
64 Procedure SetupComponent;Override;
65 Destructor Destroy;Override;
66 Procedure LoadFromStream(Stream: TStream);Override;
67 Procedure LoadFromFile(Const FileName:String);Override;
68 Procedure SaveToFile(const Filename: String);Override;
69 Procedure SaveToStream(Stream: TStream);Override;
70 Function CopyGraphic:TGraphic;Override;
71 Procedure LoadFromHandle(Handle:LongWord);Override;
72 Public
73 Property Device:LongWord read FDeviceHandle write FDeviceHandle;
74 End;
75
76 TBitmap=Class;
77
78 TBitmapCanvas=Class(TCanvas)
79 Protected
80 FBitmap:TBitmap;
81 Public
82 Procedure CreateHandle;Override;
83 Procedure DestroyHandle;Override;
84 End;
85
86 {$HINTS OFF}
87 TBitmap=Class(TGraphic)
88 Protected
89 FHeight:LongInt;
90 FWidth:LongInt;
91 FEmpty:Boolean;
92 FOrigin:TBitmap;
93 FBitmapHandle:LongWord;
94 FBitmapPS:LongWord;
95 FBitmapDC:LongWord;
96 FScalX,FScalY:LongWord;
97 FBitmapPal:LongWord;
98 FColorCount:LongInt;
99 FOrigBitCount,FOrigPlanes:LongInt; //original BitCount, also used For Saving
100 FOldBitmap:LongWord;
101 FOldPalette:LongWord;
102 FBitmapMem:Pointer;
103 FBitmapMemLength:LongInt;
104 FCanvas:TBitmapCanvas;
105 FXHotSpot,FYHotSpot:LongInt;
106 FIsInvalid:Boolean;
107 Protected
108 Procedure NewImage(BitmapData:Pointer;BitmapSize,OffsBits:LongWord;Mask:Boolean);
109 Procedure SetupBitmapColors(Header:Pointer;Mask:Boolean);
110 Function GetEmpty:Boolean;Override;
111 Function GetHeight:LongInt;Override;
112 Procedure SetHeight(NewHeight:LongInt);Override;
113 Function GetWidth:LongInt;Override;
114 Procedure SetWidth(NewWidth:LongInt);Override;
115 Procedure ReadStream(Stream:TStream;Size:LongInt);Virtual;
116 Procedure ReleaseBitmap;Virtual;
117 Procedure SetupBitmap;Virtual;
118 Function GetHandle:LongWord;Override;
119 Function GetCanvas:TCanvas;Override;
120 Function GetSize:LongInt;Override;
121 Protected
122 PermanentHandle:Boolean;
123 Procedure SetupComponent;Override;
124 Procedure Changed;Override;
125 Procedure InvalidImage;Virtual;
126 Procedure PaletteChanged;Override;
127 Procedure Update;Virtual;
128 Public
129 Procedure CreateHandle;Virtual;
130 Procedure DestroyHandle;Virtual;
131 Procedure Assign(Source:TPersistent);Override;
132 Procedure CopyToClipboard(Const Src:TRect);
133 Function LoadFromClipBoard:Boolean;
134 // create mask containing 0 in areas that are the transparent color
135 Function CreateMask( Color: TColor ): TGraphic; Override;
136 // create mask, using (0,0) for transparent color
137 Function CreateAutoMask: TBitmap;
138 // create a new copy, masking off the areas in the mask that are 0
139 // this masked version can then be used with DrawMasked.
140 Function CopyMasked( Mask: TBitmap ): TBitmap;
141 // draw onto canvas, assuming this bitmap is premasked (e.g. came from CopyMasked)
142 // and using the given Mask
143 Procedure DrawMasked( DestCanvas: TCanvas;
144 Mask: TBitmap;
145 SrcRect: TRect;
146 X,Y: longint );
147 // draw bitmap, masked and halftoned.
148 Procedure DrawMaskedDisabled( DestCanvas: TCanvas;
149 Mask: TBitmap;
150 SrcRect: TRect;
151 X,Y: longint );
152
153 Destructor Destroy;Override;
154 Procedure LoadFromStream(Stream:TStream);Override;
155 Procedure SaveToStream(Stream:TStream);Override;
156 Procedure LoadFromResourceId(Id:LongWord);Override;
157 Procedure LoadFromResourceName(Const Name:String);Override;
158 Procedure LoadFromMem(Var Buf;Size:LongInt);Override;
159 Procedure LoadFromBitmap(Bitmap:TBitmap);
160 Procedure LoadFromHandle(AHandle:LongWord);Override;
161 Function CopyGraphic:TGraphic;Override;
162 Function Copy:TBitmap;
163 Procedure Draw(Canvas:TCanvas;Const Dest:TRect);Override;
164 Procedure DrawBitmapBits(SrcRec: TRect;Canvas: TCanvas;DstRec: TRect);
165 Procedure PartialDraw(Canvas:TCanvas;Const Src,Dest:TRect);Override;
166 Procedure DrawDisabled(Canvas:TCanvas;Const Dest:TRect);Virtual;
167 Procedure RealizePalette(Canvas:TCanvas);
168 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
169 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
170 Function WriteSCUResourceName(Stream:TResourceStream;ResName:TResourceName):Boolean;Override;
171 Procedure CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);Override;
172 Function IsEqual(Bitmap:TBitmap):Boolean;
173 Property Device:LongWord Read FBitmapDC;
174 Property ColorCount:LongInt Read FColorCount;
175 Procedure ReleaseMemoryCopy; // releases the in-memory copy of the bitmap.
176 End;
177 {$HINTS ON}
178
179 TBitmapClass=Class Of TBitmap;
180
181
182 TIcon=Class(TBitmap)
183 Protected
184 FMaskHandle:LongWord;
185 FMaskDC:LongWord;
186 FMaskPS:LongWord;
187 FMaskPal:LongWord;
188 FMaskColorCount:LongWord;
189 FMaskWidth,FMaskHeight:LongWord;
190 FIconPointerHandle:LongWord;
191 FMaskCanvas:TBitmapCanvas;
192 FOldMaskBitmap:LongWord;
193 FOldMaskPalette:LongWord;
194 Procedure SetupBitmap;Override;
195 Function GetHandle:LongWord;Override;
196 Procedure ReleaseBitmap;Override;
197 Function GetMaskCanvas:TCanvas;
198 Protected
199 Procedure SetupComponent;Override;
200 Procedure InvalidImage;Override;
201 Procedure CreateIconPointerHandle;
202 Public
203 Procedure Draw(Canvas:TCanvas;Const Dest:TRect);Override;
204 Procedure CreateHandle;Override;
205 Procedure DestroyHandle;Override;
206 Procedure Update;Override;
207 Procedure CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);Override;
208 Procedure LoadFromResourceName(Const Name:String);Override;
209 Property MaskHandle:LongWord Read FMaskHandle;
210 Property ColorHandle:LongWord Read FBitmapHandle;
211 Property MaskPresentationSpaceHandle:LongWord Read FMaskPS;
212 Property MaskDevice:LongWord Read FMaskDC;
213 Property MaskWidth:LongWord Read FMaskWidth;
214 Property MaskHeight:LongWord Read FMaskHeight;
215 Property MaskPalette:LongWord Read FMaskPal;
216 Property MaskCanvas:TCanvas Read GetMaskCanvas;
217 End;
218
219
220 TPointer=Class(TIcon)
221 Protected
222 Procedure SetupComponent;Override;
223 Procedure InvalidImage;Override;
224 Property XHotSpot:LongInt Read FXHotSpot Write FXHotSpot;
225 Property YHotSpot:LongInt Read FYHotSpot Write FYHotSpot;
226 End;
227
228 TBitmapList=Class(TList)
229 Protected
230 FDuplicates:Boolean; {only For Add}
231 FBitmapClass:TBitmapClass;
232 Function CopyBitmap(original:TBitmap):TBitmap;
233 Function GetBitmap(Index:LongInt):TBitmap;
234 Procedure SetBitmap(Index:LongInt;Bitmap:TBitmap);
235 Property Items;
236 Protected
237 Procedure FreeItem(Item:Pointer);Override;
238 Public
239 Function Add(Item:TBitmap):LongInt;
240 Procedure Insert(Index:LongInt;Item:TBitmap);
241 Function IndexOfOrigin(Item:TBitmap):LongInt;
242 Function AddResourceId(BmpId:LongWord):LongInt;
243 Function AddResourceName(Const Name:String):LongInt;
244 Property Bitmaps[Index:LongInt]:TBitmap Read GetBitmap Write SetBitmap;
245 Property Duplicates:Boolean Read FDuplicates Write FDuplicates;
246 Property BitmapClass:TBitmapClass Read FBitmapClass Write FBitmapClass;
247 End;
248
249 TResType=(rtBitmap,rtCursor,rtIcon);
250
251 TImageType=(itImage,itMask);
252
253 TOverlay = 0..3;
254
255 TLoadResource=(lrDefaultColor, lrDefaultSize, lrFromFile,
256 lrMap3DColors, lrTransparent, lrMonoChrome);
257
258 TLoadResources=Set Of TLoadResource;
259
260 //Item for BitmapList property of TImageList class
261 PImageItem=^TImageItem;
262 TImageItem=Record
263 Bitmap:TBitmap;
264 Mask:TBitmap;
265 Icon:TIcon;
266 End;
267
268 TImageList=Class;
269
270 TImageItemList=Class(TList)
271 ImageList:TImageList;
272 END;
273
274 TImageList=Class(TComponent)
275 Protected
276 FMasked:Boolean;
277 FImageType:TImageType;
278 FOnChange:TNotifyEvent;
279 FList:TImageItemList;
280 Protected
281 Function GetCount:LongInt;
282 Procedure SetList(Item:TImageItemList);
283 Protected
284 Procedure Change;Virtual;
285 Procedure Initialize;
286 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
287 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
288 Function NewItem:PImageItem;Virtual;
289 Procedure DisposeItem(Item:PImageItem);Virtual;
290 Public
291 Procedure SetupComponent;Override;
292 Destructor Destroy;Override;
293 Function Add(Image,Mask:TBitmap):LongInt;
294 Function AddIcon(Image:TIcon):LongInt;
295 Procedure AddImages(Value:TImageList);
296 Procedure Clear;
297 Procedure Delete(Index:LongInt);
298 Procedure Draw(Canvas:TCanvas;X,Y,Index:LongInt);
299 Procedure GetBitmap(Index:LongInt;Image:TBitmap);
300
301 // Gets a reference to the internal bitmap,
302 // rather than making a copy.
303 Function GetBitmapReference( Index:LongInt ): TBitmap;
304
305 Procedure GetMask(Index:LongInt;Mask:TBitmap);
306 Procedure GetIcon(Index: Integer;Icon:TIcon);
307 Procedure Insert(Index:LongInt;Image,Mask:TBitmap);
308 Procedure InsertIcon(Index:LongInt;Image:TIcon);
309 Procedure Move(CurIndex,NewIndex:LongInt);
310 Procedure Replace(Index:LongInt;Image,Mask:TBitmap);
311 Procedure ReplaceIcon(Index:LongInt;Image:TIcon);
312 Public
313 Property Count:LongInt read GetCount;
314 Published
315 Property ImageType:TImageType read FImageType write FImageType;
316 Property Masked:Boolean read FMasked write FMasked;
317 Property OnChange: TNotifyEvent read FOnChange write FOnChange;
318 Property BitmapList:TImageItemList read FList write SetList;stored False;
319 End;
320
321 TPicture=Class(TComponent)
322 Protected
323 FGraphic:TGraphic;
324 FOnChange:TNotifyEvent;
325 Protected
326 Function GetBitmap:TBitmap;
327 Function GetHeight:LongInt;
328 Function GetIcon:TIcon;
329 Function GetMetafile:TMetafile;
330 Function GetWidth:LongInt;
331 Procedure SetBitmap(Value: TBitmap);
332 Procedure SetGraphic(Value: TGraphic);
333 Procedure SetIcon(Value: TIcon);
334 Procedure SetMetafile(Value: TMetafile);
335 Function GetEmpty:Boolean;
336 Protected
337 Procedure Changed(Sender: TObject);
338 Procedure AssignTo(Dest:TPersistent);Override;
339 Public
340 Destructor Destroy;Override;
341 Procedure LoadFromFile(Const Filename:string);
342 Procedure SaveToFile(Const Filename: string);
343 Procedure ForceType(GraphicType:TGraphicClass);
344 Public
345 Function HasFormat(GraphicClass:TGraphicClass):Boolean;
346 Procedure Assign(Source:TPersistent);Override;
347 Public
348 Property Empty:Boolean read GetEmpty;
349 Property Bitmap:TBitmap read GetBitmap write SetBitmap;
350 Property Graphic:TGraphic read FGraphic write SetGraphic;
351 Property Height:LongInt read GetHeight;
352 Property Icon:TIcon read GetIcon write SetIcon;
353 Property Metafile:TMetafile read GetMetafile write SetMetafile;
354 Property Width:LongInt read GetWidth;
355 Property OnChange:TNotifyEvent read FOnChange write FOnChange;
356 End;
357
358
359Implementation
360
361
362{
363ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
364º º
365º Speed-Pascal/2 Version 2.0 º
366º º
367º Speed-Pascal Component Classes (SPCC) º
368º º
369º This section: TBitmapCanvas Class Implementation º
370º º
371º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
372º º
373ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
374}
375
376
377Procedure TBitmapCanvas.CreateHandle;
378Begin
379 If FBitmap<>Nil Then FBitmap.CreateHandle;
380End;
381
382Procedure TBitmapCanvas.DestroyHandle;
383Begin
384 If FBitmap<>Nil Then FBitmap.DestroyHandle;
385End;
386
387{
388ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
389º º
390º Speed-Pascal/2 Version 2.0 º
391º º
392º Speed-Pascal Component Classes (SPCC) º
393º º
394º This section: TBitmap Class Implementation º
395º º
396º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
397º º
398ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
399}
400
401Procedure TBitmap.CreateHandle;
402Begin
403 If FIsInvalid Then exit; //don't create handle for invalid objects (loop) !
404
405 {$IFDEF WIN32}
406 If FBitmapHandle=0 Then If FBitmapMem<>Nil Then
407 Begin
408 If FBitmapPS<>0 Then DestroyHandle;
409 SetupBitmap;
410 End;
411 If FBitmapHandle=0 Then InvalidImage;
412 If FBitmapPS=0 Then
413 Begin
414 FBitmapPS:=CreateCompatibleDC(0);
415 FOldBitmap:=SelectObject(FBitmapPS,FBitmapHandle);
416 End;
417 If FCanvas = Nil Then
418 Begin
419 FCanvas.Create(Self);
420 FCanvas.FBitmap:=Self;
421 Include(FCanvas.ComponentState, csDetail);
422 End;
423 If FCanvas.Handle<>FBitmapPS Then
424 Begin
425 FCanvas.Handle:=FBitmapPS;
426 FCanvas.Init;
427 RealizePalette(Nil);
428 End;
429 {$ENDIF}
430End;
431
432Procedure TBitmap.DestroyHandle;
433Begin
434 If PermanentHandle Then exit;
435
436 {$IFDEF WIN32}
437 If FBitmapPal<>0 Then
438 If FBitmapPS<>0 Then SelectObject(FBitmapPS,FOldPalette);
439 FOldPalette:=0;
440 If FBitmapPS<>0 Then
441 Begin
442 SelectObject(FBitmapPS,FOldBitmap);
443 If not DeleteDC(FBitmapPS) Then InvalidImage;
444 End;
445 FBitmapPS:=0;
446 If FCanvas<>Nil Then FCanvas.Handle:=0;
447 FOldBitmap:=0;
448 If FBitmapHandle<>0 Then If not DeleteObject(FBitmapHandle) Then InvalidImage;
449 FBitmapHandle:=0;
450 {$ENDIF}
451End;
452
453Procedure TBitmap.DrawBitmapBits(SrcRec: TRect;Canvas: TCanvas;DstRec: TRect);
454{$IFDEF OS2}
455Var
456 DC: HDC;
457 PS: HPS;
458 BM: HBITMAP;
459 Size: SIZEL;
460 Points: array[0..1] of TRect;
461{$ENDIF}
462Begin
463 {$IFDEF OS2}
464 If Canvas = nil Then Exit;
465
466 DC := 0;
467 PS := 0;
468
469 Try
470 DC := DevOpenDC(AppHandle, OD_MEMORY, '*', 0,Nil, GpiQueryDevice(Canvas.Handle));
471
472 Size.CX := 0;
473 Size.CY := 0;
474
475 PS := GpiCreatePS(AppHandle, DC, Size,PU_PELS or GPIT_MICRO or GPIA_ASSOC);
476
477 BM := Handle;
478 Try
479 GpiSetBitmap(Self.Canvas.Handle, 0);
480 GpiSetBitmap(PS, BM);
481
482 Points[0] := DstRec;
483 Points[1] := SrcRec;
484
485 GpiBitBlt(Canvas.Handle,
486 PS,
487 4,
488 Points[0].LeftBottom,
489 ROP_SRCCOPY,
490 BBO_IGNORE);
491
492 Finally
493 GpiSetBitmap(PS, 0);
494 GpiSetBitmap(Self.Canvas.Handle, BM);
495 End;
496
497 Finally
498 If PS <> 0 Then GpiDestroyPS(PS);
499 If DC <> 0 Then DevCloseDC(DC);
500 End;
501 {$ENDIF}
502End;
503
504{$HINTS OFF}
505Function TBitmap.CreateMask( Color:TColor ):TGraphic;
506{$IFDEF OS2}
507Var Mask: TBitmap;
508 X,Y: longint;
509{$ENDIF}
510Begin
511 {$IFDEF OS2}
512 Mask := TBitmap.Create;
513 Mask.CreateNew( Width, Height, 2 );
514// Mask.Canvas.Palette.Colors[ 0 ] := clBlack;
515// Mask.Canvas.Palette.Colors[ 0 ] := clWhite;
516 For Y := 0 to Height - 1 do
517 For X := 0 to Width - 1 do
518 if Canvas.Pixels[ X, Y ] = Color Then
519 Mask.Canvas.Pixels[ X, Y ] := 0
520 else
521 Mask.Canvas.Pixels[ X, Y ] := 1;
522
523 Result := Mask;
524 {$ENDIF}
525End;
526{$HINTS ON}
527
528Function TBitmap.CreateAutoMask:TBitmap;
529Begin
530 Result := TBitmap( CreateMask( Canvas.Pixels[ 0, 0 ] ) );
531End;
532
533Function TBitmap.CopyMasked( Mask:TBitmap ):TBitmap;
534Var
535 aRect: TRect;
536Begin
537 Result := self.Copy;
538 aRect := Rect( 0, 0, Width, Height );
539
540 // clear out areas of the new bitmap, where mask is 0
541 Mask.Canvas.BitBlt( Result.Canvas,
542 aRect,
543 aRect,
544 cmSrcAnd,
545 bitFIgnore ); // scaling is irrelevant anyway
546End;
547
548Procedure TBitmap.DrawMasked( DestCanvas: TCanvas;
549 Mask: TBitmap;
550 SrcRect: TRect;
551 X,Y: longint );
552Var
553 DestRect: TRect;
554 OldBrushColor: TColor;
555 OldPenColor: TColor;
556Begin
557 DestRect := Rect( X, Y,
558 X + SrcRect.Right - SrcRect.Left,
559 Y + SrcRect.Top - SrcRect.Bottom );
560
561 if ( Mask.Width <> Width )
562 or ( Mask.Height <> Height ) then
563 raise Exception.Create( 'TBitmap.DrawMasked: mask dimensions do not match bitmap' );
564
565 OldBrushColor := DestCanvas.Brush.Color;
566 OldPenColor := DestCanvas.Pen.Color;
567
568 // set black and white since this is used
569 // to translate mask before bitblt
570 DestCanvas.Brush.Color := clWhite;
571 DestCanvas.Pen.Color := clBlack;
572
573 // clear areas to draw on in dest
574 Mask.Canvas.BitBlt( DestCanvas,
575 DestRect,
576 SrcRect,
577 cmNotSrcAndDest,
578 bitFIgnore ); // scaling is irrelevant anyway
579
580 // OR ourselves onto the dest
581 Canvas.BitBlt( DestCanvas,
582 DestRect,
583 SrcRect,
584 cmSrcPaint, // equivalent to OR
585 bitFIgnore ); // scaling is irrelevant anyway
586
587 DestCanvas.Brush.Color := OldBrushColor;
588 DestCanvas.Pen.Color := OldPenColor;
589
590End;
591
592Procedure TBitmap.DrawMaskedDisabled( DestCanvas: TCanvas;
593 Mask: TBitmap;
594 SrcRect: TRect;
595 X,Y: longint );
596Var
597 DestRect: TRect;
598 OldBrushColor: TColor;
599 OldPenColor: TColor;
600 OldBrushStyle: TBrushStyle;
601Begin
602 DestRect := Rect( X, Y,
603 X + SrcRect.Right - SrcRect.Left,
604 Y + SrcRect.Top - SrcRect.Bottom );
605
606 if ( Mask.Width <> Width )
607 or ( Mask.Height <> Height ) then
608 raise Exception.Create( 'TBitmap.DrawMasked: mask dimensions do not match bitmap' );
609
610 OldBrushColor := DestCanvas.Brush.Color;
611 OldPenColor := DestCanvas.Pen.Color;
612 OldBrushStyle := DestCanvas.Brush.Style;
613
614 // set black and white since this is used
615 // to translate mask before bitblt
616 DestCanvas.Brush.Color := clWhite;
617 DestCanvas.Pen.Color := clBlack;
618
619 // set half tone pattern which we will combine with when drawing...
620 DestCanvas.Brush.Style := bsHalfTone;
621
622 // clear areas to draw on in dest
623 // (which is areas where the mask is 1 and the pattern is 1)
624 Mask.Canvas.BitBlt( DestCanvas,
625 DestRect,
626 SrcRect,
627 cmSrcAndPatErase,
628 bitFIgnore ); // scaling is irrelevant anyway
629
630 // OR ourselves onto the dest
631 Canvas.BitBlt( DestCanvas,
632 DestRect,
633 SrcRect,
634 cmSrcAndPatOrDest,
635 bitFIgnore ); // scaling is irrelevant anyway}
636
637 DestCanvas.Brush.Color := OldBrushColor;
638 DestCanvas.Pen.Color := OldPenColor;
639 DestCanvas.Brush.Style := OldBrushStyle;
640End;
641
642Var LastcbInfo:LongWord;
643
644Procedure TBitmap.LoadFromHandle(AHandle:LongWord);
645Var
646 TheBitmapMem:^LongInt;
647 TheBitmapMemLength:LongInt;
648{$IFDEF OS2}
649Var
650 hdcDst:LongInt;
651 hpsDst:LongInt;
652 bmpTemp:BITMAPINFOHEADER2;
653 sizl:SIZEL;
654 HPS:LongWord;
655 rclTemp:TRect;
656 ptlDst:POINTL;
657Label ex;
658{$ENDIF}
659{$IFDEF Win95}
660Var
661 BI:BitmapCoreInfo;
662 pbi:^BitmapCoreInfo;
663 P,pp:Pointer;
664 cbInfo,cbBuffer:LongWord;
665 BI2:BitmapInfo;
666 ADC,MemDC:LongWord;
667{$ENDIF}
668Begin
669 FIsInvalid:=False; //reset flag !
670 ReleaseBitmap;
671
672 {$IFDEF OS2}
673 HPS:=WinGetPS(HWND_DESKTOP);
674
675 bmpTemp.cbFix := SizeOf(BITMAPINFOHEADER2);
676 GpiQueryBitmapInfoHeader(AHandle,bmpTemp);
677 FBitmapHandle:=GpiCreateBitmap(HPS,bmpTemp,0,Nil,Nil);
678 If FBitmapHandle=0 Then Exit;
679
680 rclTemp.Left := 0;
681 rclTemp.Right := bmpTemp.CX;
682 rclTemp.Bottom := 0;
683 rclTemp.Top := bmpTemp.CY;
684
685 hdcDst := DevOpenDC(AppHandle,OD_MEMORY,'*',0,Nil,0);
686 If hdcDst=0 Then
687 Begin
688 GpiDeleteBitmap(FBitmapHandle);
689 Goto ex; //Error
690 End;
691
692 sizl.CX := 1{bmpTemp.CX};
693 sizl.CY := 1{bmpTemp.CY};
694 hpsDst := GpiCreatePS(AppHandle, hdcDst, sizl,
695 PU_PELS Or GPIA_ASSOC Or GPIT_MICRO
696 {PU_PELS Or GPIF_DEFAULT Or GPIT_MICRO Or GPIA_ASSOC});
697 If hpsDst=0 Then
698 Begin
699 GpiDeleteBitmap(FBitmapHandle);
700 DevCloseDC(hdcDst);
701 Goto ex; //Error
702 End;
703
704 //GpiSetBitmap(hpsSrc, hbmSrc);
705 GpiSetBitmap(hpsDst, FBitmapHandle);
706 FBitmapPS:=hpsDst;
707
708 ptlDst.X:=0;
709 ptlDst.Y:=0;
710 WinDrawBitmap(hpsDst,AHandle,Nil,ptlDst,0,0,DBM_NORMAL Or DBM_IMAGEATTRS);
711 Update;
712
713 GpiSetBitmap(hpsDst,0);
714 GpiDestroyPS(hpsDst);
715 FBitmapPS:=0;
716 DevCloseDC(hdcDst);
717 GpiDeleteBitmap(FBitmapHandle);
718 FBitmapHandle:=0;
719
720 TheBitmapMem:=FBitmapMem;
721 FBitmapMem:=Nil;
722 TheBitmapMemLength:=FBitmapMemLength;
723 FBitmapMemLength:=0;
724 FBitmapHandle:=0;
725 FBitmapPS:=0;
726 If TheBitmapMemLength>0 Then
727 Begin
728 LoadFromMem(TheBitmapMem^,TheBitmapMemLength);
729 FreeMem(TheBitmapMem,TheBitmapMemLength);
730 End;
731ex:
732 WinReleasePS(HPS);
733 {$ENDIF}
734 {$IFDEF WIN32}
735 ADC:=GetDC(0);
736 MemDC:=CreateCompatibleDC(ADC);
737
738 FillChar(BI,SizeOf(BI),0);
739
740 FillChar(BI2,SizeOf(BI2),0);
741 BI2.bmiHeader.biSize:=SizeOf(BITMAPINFOHEADER);
742 GetDIBits(ADC,AHandle,0,0,Nil,BI2,0);
743 If FOrigBitCount>0 Then BI2.bmiHeader.biBitCount:=FOrigBitCount;
744 If FOrigPlanes>0 Then BI2.bmiHeader.biPlanes:=FOrigPlanes;
745
746 cbInfo:=SizeOf(BitmapCoreHeader)+SizeOf(RGBTriple)*(1 Shl BI2.bmiHeader.biBitCount);
747 LastcbInfo:=cbInfo;
748 GetMem(pbi,cbInfo);
749 With pbi^.bmciHeader Do
750 Begin
751 bcSize:=SizeOf(BitmapCoreHeader);
752 bcWidth:=BI2.bmiHeader.biWidth;
753 bcHeight:=BI2.bmiHeader.biHeight;
754 bcPlanes:=BI2.bmiHeader.biPlanes;
755 bcBitCount:=BI2.bmiHeader.biBitCount;
756 End;
757 cbBuffer:=(((BI2.bmiHeader.biBitCount*BI2.bmiHeader.biWidth)+31) Div 32)
758 *4*BI2.bmiHeader.biHeight*BI2.bmiHeader.biPlanes;
759 GetMem(P,cbBuffer);
760 GetDIBits(ADC,AHandle,0,BI2.bmiHeader.biHeight,P^,pbi^,DIB_RGB_COLORS);
761
762 If FBitmapMem<>Nil Then FreeMem(FBitmapMem,FBitmapMemLength);
763 FBitmapMemLength:=cbInfo+cbBuffer;
764 GetMem(FBitmapMem,FBitmapMemLength);
765 pp:=FBitmapMem;
766 Move(pbi^,pp^,cbInfo);
767 Inc(pp,cbInfo);
768 Move(P^,pp^,cbBuffer);
769
770 FreeMem(pbi,cbInfo);
771 FreeMem(P,cbBuffer);
772
773 If MemDC<>0 Then If not DeleteDC(MemDC) Then InvalidImage;
774 If ADC<>0 Then If ReleaseDC(0,ADC)=0 Then InvalidImage;
775 {$ENDIF}
776
777 FBitmapHandle:=0;
778
779 TheBitmapMem:=FBitmapMem;
780 FBitmapMem:=Nil;
781 TheBitmapMemLength:=FBitmapMemLength;
782 FBitmapMemLength:=0;
783 FBitmapHandle:=0;
784 FBitmapPS:=0;
785 If TheBitmapMemLength>0 Then
786 Begin
787 LoadFromMem(TheBitmapMem^,TheBitmapMemLength);
788 FreeMem(TheBitmapMem,TheBitmapMemLength);
789 End;
790End;
791
792Function TBitmap.LoadFromClipBoard:Boolean;
793Var hbmClipbrd:LongWord;
794Begin
795 FIsInvalid:=False; //reset flag !
796
797 Result:=False;
798 Clipboard.Open(Handle);
799 If Clipboard.IsFormatAvailable(cfBitmap) Then
800 Begin
801 hbmClipbrd:=Clipboard.GetData(cfBitmap);
802 If hbmClipbrd<>0 Then
803 Begin
804 LoadFromHandle(hbmClipbrd);
805 Result:=Not Empty;
806 End;
807 End;
808
809 Clipboard.Close;
810End;
811
812Procedure TBitmap.Assign(Source:TPersistent);
813Begin
814 If Source Is TBitmap Then LoadFromBitmap(TBitmap(Source))
815 Else Inherited Assign(Source);
816End;
817
818Procedure TBitmap.CopyToClipboard(Const Src:TRect);
819{$IFDEF OS2}
820Var HPS:LongWord;
821 bmpClipbrd:BITMAPINFOHEADER2;
822 rclClipbrd:TRect;
823 hbmClipbrd:HBITMAP;
824 hpsDst,hdcDst:LongWord;
825 bmp:BITMAPINFOHEADER2;
826 sizl:SIZEL;
827 aptl:Array[0..3] Of POINTL;
828{$ENDIF}
829{$IFDEF WIN32}
830Var
831 hbmClipBrd,Temp:HBITMAP;
832 ScreenDC:HDC;
833 hdcDst,hdcSrc:HDC;
834{$ENDIF}
835Begin
836{$IFDEF OS2}
837 If Handle=0 Then Exit;
838
839 HPS:=WinGetPS(HWND_DESKTOP);
840
841 bmpClipbrd.cbFix := SizeOf(BITMAPINFOHEADER2);
842 GpiQueryBitmapInfoHeader(Handle,bmpClipbrd);
843 bmpClipbrd.CX:=Src.Right-Src.Left;
844 bmpClipbrd.CY:=Src.Top-Src.Bottom;
845 hbmClipbrd:=GpiCreateBitmap(HPS,bmpClipbrd,0,Nil,Nil);
846 If hbmClipbrd=0 Then Exit;
847
848 rclClipbrd.Left := 0;
849 rclClipbrd.Right := bmpClipbrd.CX;
850 rclClipbrd.Bottom := 0;
851 rclClipbrd.Top := bmpClipbrd.CY;
852
853 hdcDst := DevOpenDC(AppHandle,OD_MEMORY,'*',0,Nil,0);
854 If hdcDst=0 Then
855 Begin
856 GpiDeleteBitmap(hbmClipbrd);
857 WinReleasePS(HPS);
858 exit;
859 End;
860
861 bmp.cbFix := SizeOf(BITMAPINFOHEADER2);
862 GpiQueryBitmapInfoHeader(hbmClipbrd, bmp);
863 sizl.CX := 1{bmp.CX};
864 sizl.CY := 1{bmp.CY};
865 hpsDst := GpiCreatePS(AppHandle, hdcDst, sizl,
866 PU_PELS Or GPIA_ASSOC Or GPIT_MICRO
867 {PU_PELS Or GPIF_DEFAULT Or GPIT_MICRO Or GPIA_ASSOC});
868 If hpsDst=0 Then
869 Begin
870 GpiDeleteBitmap(hbmClipbrd);
871 DevCloseDC(hdcDst);
872 WinReleasePS(HPS);
873 exit;
874 End;
875
876 //GpiSetBitmap(hpsSrc, hbmSrc);
877 GpiSetBitmap(hpsDst, hbmClipbrd);
878
879 aptl[0].X := rclClipbrd.Left;
880 aptl[0].Y := rclClipbrd.Bottom;
881 aptl[1].X := rclClipbrd.Right;
882 aptl[1].Y := rclClipbrd.Top;
883 aptl[2].X := Src.Left;
884 aptl[2].Y := Src.Bottom;
885 aptl[3].X := Src.Right;
886 aptl[3].Y := Src.Top;
887
888 If ((aptl[1].X-aptl[0].X=aptl[3].X-aptl[2].X)And
889 (aptl[1].Y-aptl[0].Y=aptl[3].Y-aptl[2].Y)) Then
890 GpiBitBlt(hpsDst,Canvas.Handle,3,aptl[0],ROP_SRCCOPY,BBO_IGNORE)
891 Else
892 GpiBitBlt(hpsDst,Canvas.Handle,4,aptl[0],ROP_SRCCOPY,BBO_IGNORE);
893
894 GpiSetBitmap(hpsDst,0);
895 GpiDestroyPS(hpsDst);
896 DevCloseDC(hdcDst);
897 {$ENDIF}
898 {$IFDEF Win95}
899 CreateHandle;
900 ScreenDC:=GetDC(0);
901 If ScreenDC=0 Then exit;
902 hdcDst:=CreateCompatibleDC(ScreenDC);
903 If hdcDst=0 Then
904 Begin
905 ReleaseDC(0,ScreenDC);
906 exit;
907 End;
908 hbmClipBrd:=CreateCompatibleBitmap(ScreenDC,Width,Height);
909 if hbmClipBrd=0 Then
910 Begin
911 ReleaseDC(0,ScreenDC);
912 exit;
913 End;
914 SelectObject(hdcDst,hbmClipBrd);
915 WinGDI.BitBlt(hdcDst,0,0,Width,Height,FBitmapPS,0,0,SRCCOPY);
916 DeleteDC(hdcDst);
917 ReleaseDC(0,ScreenDC);
918 {$ENDIF}
919
920 Clipboard.Open(0);
921 Clipboard.Empty;
922 Clipboard.SetData(hbmClipBrd,cfBitmap);
923 Clipboard.Close;
924End;
925
926Procedure TBitmap.SetupComponent;
927Begin
928 Inherited SetupComponent;
929
930 Name:='Bitmap';
931 FEmpty:=True;
932 FBitmapHandle:=0;
933 FBitmapPS:=0;
934 FBitmapDC:=0;
935End;
936
937Procedure TBitmap.changed;
938Begin
939 Inherited changed;
940 If Owner Is TControl Then TControl(Owner).Invalidate;
941End;
942
943Procedure TBitmap.PaletteChanged;
944Begin
945 {$IFDEF OS2}
946 If FBitmapPal<>0 Then GpiDeletePalette(FBitmapPal);
947 {$ENDIF}
948 {$IFDEF Win95}
949 If FBitmapPal<>0 Then DeleteObject(FBitmapPal);
950 {$ENDIF}
951 FBitmapPal:=Canvas.Palette.Handle;
952End;
953
954Procedure TBitmap.ReleaseBitmap;
955Begin
956 FEmpty:=True;
957
958 If FCanvas<>Nil Then
959 Begin
960 FCanvas.Destroy;
961 FCanvas:=Nil;
962 End;
963
964 {$IFDEF OS2}
965 If FBitmapPal<>0 Then GpiDeletePalette(FBitmapPal);
966 If FBitmapHandle<>0 Then
967 Begin
968 If FBitmapPS<>0 Then GpiSetBitmap(FBitmapPS,0);
969 GpiDeleteBitmap(FBitmapHandle);
970 End;
971 If FBitmapPS<>0 Then GpiDestroyPS(FBitmapPS);
972 If FBitmapDC<>0 Then DevCloseDC(FBitmapDC);
973 {$ENDIF}
974 {$IFDEF Win95}
975 If FBitmapPS<>0 Then
976 Begin
977 If FBitmapHandle<>0 Then SelectObject(FBitmapPS,FOldBitmap);
978 If FBitmapPal<>0 Then SelectObject(FBitmapPS,FOldPalette);
979 End;
980 If FBitmapPS<>0 Then If not DeleteDC(FBitmapPS) Then InvalidImage;
981 If FBitmapPal<>0 Then If not DeleteObject(FBitmapPal) Then InvalidImage;
982 If FBitmapHandle<>0 Then If not DeleteObject(FBitmapHandle) Then InvalidImage;
983 {$ENDIF}
984 FBitmapPS:=0;
985 FBitmapPal:=0;
986 FBitmapHandle:=0;
987 FBitmapDC:=0;
988
989 ReleaseMemoryCopy;
990End;
991
992Procedure TBitmap.ReleaseMemoryCopy; // releases the in-memory copy of the bitmap.
993begin
994 If FBitmapMemLength<>0 Then
995 If FBitmapMem<>Nil Then
996 Begin
997 FreeMem(FBitmapMem,FBitmapMemLength);
998 FBitmapMem:=Nil;
999 FBitmapMemLength:=0;
1000 End;
1001end;
1002
1003Destructor TBitmap.Destroy;
1004Begin
1005 ReleaseBitmap;
1006
1007 Inherited Destroy;
1008End;
1009
1010Function TBitmap.GetHandle:LongWord;
1011Begin
1012 If FBitmapHandle=0 Then If FBitmapMem<>Nil Then SetupBitmap;
1013 Result:=FBitmapHandle;
1014End;
1015
1016Function TBitmap.GetSize;
1017Begin
1018 Result:=FBitmapMemLength;
1019End;
1020
1021Function TBitmap.GetCanvas:TCanvas;
1022Begin
1023 If FBitmapPS=0 Then CreateHandle;
1024
1025 If FCanvas = Nil Then
1026 Begin
1027 FCanvas.Create(Self);
1028 FCanvas.FBitmap:=Self;
1029 Include(FCanvas.ComponentState, csDetail);
1030 FCanvas.Handle := FBitmapPS;
1031 FCanvas.Init;
1032 End
1033 Else
1034 Begin
1035 If FCanvas.Handle<>FBitmapPS Then
1036 Begin
1037 FCanvas.Handle:=FBitmapPS;
1038 FCanvas.Init;
1039 End;
1040 End;
1041 Result := FCanvas;
1042End;
1043
1044Procedure TBitmap.DrawDisabled(Canvas:TCanvas;Const Dest:TRect);
1045Var OldLineWidth:LongInt;
1046 OldLineType:TPenStyle;
1047 OldBkMode:TBrushMode;
1048 OldColor:TColor;
1049 X:LongInt;
1050 {$IFDEF Win95}
1051 OldPal:LongWord;
1052 {$ENDIF}
1053Begin
1054 If Empty Then Exit;
1055
1056 {$IFDEF OS2}
1057 {OldPal:=GpiQueryPalette(Canvas.Handle);
1058 If OldPal<>FBitmapPal Then GpiSelectPalette(Canvas.Handle,FBitmapPal);}
1059 {$ENDIF}
1060 {$IFDEF Win95}
1061 OldPal:=SelectPalette(Canvas.Handle,FBitmapPal,True);
1062 {$ENDIF}
1063
1064 Draw(Canvas,Dest);
1065
1066 OldLineWidth:=Canvas.Pen.Width;
1067 OldLineType:=Canvas.Pen.Style;
1068 OldBkMode:=Canvas.Brush.Mode;
1069 OldColor:=Canvas.Pen.color;
1070
1071 If Canvas.Control<>Nil {typecast To have access To BackColor}
1072 Then Canvas.Pen.color:=TForm(Canvas.Control).color;
1073 Canvas.Pen.Width:=1;
1074 Canvas.Brush.Mode:=bmTransparent;
1075 Canvas.Pen.Style:=psInsideFrame; // single pixel dots.
1076 For X:=Dest.Left To Dest.Right Do
1077 Begin
1078 // draw alternate columns offset by 1 pixel
1079 // to create 50% half tone
1080 if ( X and 1 ) = 0 then
1081 Canvas.Line(X,Dest.Bottom,X,Dest.Top)
1082 else
1083 Canvas.Line(X,Dest.Bottom + 1,X,Dest.Top);
1084 End;
1085
1086 Canvas.Pen.Width:=OldLineWidth;
1087 Canvas.Pen.Style:=OldLineType;
1088 Canvas.Brush.Mode:=OldBkMode;
1089 Canvas.Pen.color:=OldColor;
1090
1091 {$IFDEF Win95}
1092 If OldPal<>FBitmapPal Then SelectPalette(Canvas.Handle,OldPal,True);
1093 {$ENDIF}
1094 {$IFDEF OS2}
1095 {If OldPal<>FBitmapPal Then GpiSelectPalette(Canvas.Handle,OldPal);}
1096 {$ENDIF}
1097End;
1098
1099
1100Procedure TBitmap.Draw(Canvas:TCanvas;Const Dest:TRect);
1101Var {$IFDEF Win95}
1102 _Dest:TRect;
1103 OldPal:LongWord;
1104 {$ENDIF}
1105 {$IFDEF OS2}
1106 Src:TRect;
1107 ptls:Array[0..3] Of TPoint;
1108 {$ENDIF}
1109Begin
1110 If Empty Then Exit;
1111 {$IFDEF OS2}
1112 If Canvas.NonDisplayDevice Then
1113 Begin
1114 Src.Left:=0;
1115 Src.Right:=Width;
1116 Src.Bottom:=0;
1117 Src.Top:=Height;
1118 DrawBitmapBits(Src,Canvas,Dest);
1119 exit;
1120 End;
1121
1122 ptls[0].X:=Dest.Left;
1123 ptls[0].Y:=Dest.Bottom;
1124 ptls[1].X:=Dest.Right;
1125 ptls[1].Y:=Dest.Top;
1126 ptls[2].X:=0;
1127 ptls[2].Y:=0;
1128 ptls[3].X:=FWidth;
1129 ptls[3].Y:=FHeight;
1130 {OldPal:=GpiQueryPalette(Canvas.Handle);
1131 If OldPal<>FBitmapPal Then GpiSelectPalette(Canvas.Handle,FBitmapPal);}
1132 GpiBitBlt(Canvas.Handle,FBitmapPS,4,ptls[0],ROP_SRCCOPY,BBO_IGNORE);
1133 {If OldPal<>FBitmapPal Then GpiSelectPalette(Canvas.Handle,OldPal);}
1134 {$ENDIF}
1135 {$IFDEF Win95}
1136 CreateHandle;
1137 OldPal:=SelectPalette(Canvas.Handle,FBitmapPal,True);
1138
1139 _Dest := Dest;
1140 RectToWin32Rect(_Dest);
1141 TransformRectToWin32(_Dest,Canvas.Control,Canvas.Graphic);
1142
1143 If (_Dest.Right-_Dest.Left=FWidth) And (_Dest.Top-_Dest.Bottom=FHeight) Then
1144 Begin
1145 WinGDI.BitBlt(Canvas.Handle,_Dest.Left,_Dest.Bottom,
1146 FWidth,FHeight,FBitmapPS,0,0,SRCCOPY);
1147 End
1148 Else
1149 Begin
1150 StretchBlt(Canvas.Handle,_Dest.Left,_Dest.Bottom,
1151 _Dest.Right-_Dest.Left,_Dest.Top-_Dest.Bottom,
1152 FBitmapPS, 0, 0, FWidth, FHeight,SRCCOPY);
1153 End;
1154 If OldPal<>FBitmapPal Then SelectPalette(Canvas.Handle,OldPal,True);
1155 DestroyHandle;
1156 {$ENDIF}
1157End;
1158
1159
1160Procedure TBitmap.PartialDraw(Canvas:TCanvas;Const Src,Dest:TRect);
1161Var {$IFDEF Win95}
1162 OldPal:LongWord;
1163 _Src,_Dest:TRect;
1164 {$ENDIF}
1165 {$IFDEF OS2}
1166 ptls:Array[0..3] Of TPoint;
1167 {$ENDIF}
1168 {$IFDEF Win95}
1169 Procedure SourceRectToWin32(Var rec:TRect;OwnerHeight:LongInt);
1170 Begin
1171 rec.Bottom:=(OwnerHeight-rec.Bottom);
1172 rec.Top:=(OwnerHeight-rec.Top);
1173 End;
1174 {$ENDIF}
1175Begin
1176 If Empty Then Exit;
1177 {$IFDEF OS2}
1178 If Canvas.NonDisplayDevice Then
1179 Begin
1180 DrawBitmapBits(Src,Canvas,Dest);
1181 exit;
1182 End;
1183 ptls[0].X:=Dest.Left;
1184 ptls[0].Y:=Dest.Bottom;
1185 ptls[1].X:=Dest.Right;
1186 ptls[1].Y:=Dest.Top;
1187 ptls[2].X:=Src.Left;
1188 ptls[2].Y:=Src.Bottom;
1189 ptls[3].X:=Src.Right;
1190 ptls[3].Y:=Src.Top;
1191 {OldPal:=GpiQueryPalette(Canvas.Handle);
1192 If OldPal<>FBitmapPal Then GpiSelectPalette(Canvas.Handle,FBitmapPal);}
1193 GpiBitBlt(Canvas.Handle,FBitmapPS,4,ptls[0],ROP_SRCCOPY,BBO_IGNORE);
1194 {If OldPal<>FBitmapPal Then GpiSelectPalette(Canvas.Handle,OldPal);}
1195 {$ENDIF}
1196 {$IFDEF Win95}
1197 CreateHandle;
1198 OldPal:=SelectPalette(Canvas.Handle,FBitmapPal,True);
1199
1200 _Dest := Dest;
1201 RectToWin32Rect(_Dest);
1202 TransformRectToWin32(_Dest,Canvas.Control,Canvas.Graphic);
1203
1204 _Src := Src;
1205 RectToWin32Rect(_Src);
1206 SourceRectToWin32(_Src,FHeight);
1207 StretchBlt(Canvas.Handle,_Dest.Left,_Dest.Bottom,
1208 _Dest.Right-_Dest.Left,_Dest.Top-_Dest.Bottom,
1209 FBitmapPS,_Src.Left,_Src.Bottom,
1210 _Src.Right-_Src.Left,_Src.Top-_Src.Bottom,SRCCOPY);
1211
1212 If OldPal<>FBitmapPal Then SelectPalette(Canvas.Handle,OldPal,True);
1213 DestroyHandle;
1214 {$ENDIF}
1215End;
1216
1217Function TBitmap.GetEmpty:Boolean;
1218Begin
1219 GetEmpty:=FEmpty;
1220End;
1221
1222Function TBitmap.GetHeight:LongInt;
1223Begin
1224 GetHeight:=FHeight;
1225End;
1226
1227Procedure TBitmap.SetHeight(NewHeight:LongInt);
1228Begin
1229 FHeight:=NewHeight;
1230End;
1231
1232Function TBitmap.GetWidth:LongInt;
1233Begin
1234 GetWidth:=FWidth;
1235End;
1236
1237Procedure TBitmap.SetWidth(NewWidth:LongInt);
1238Begin
1239 FWidth:=NewWidth;
1240End;
1241
1242
1243Procedure TBitmap.LoadFromBitmap(Bitmap:TBitmap);
1244Begin
1245 FIsInvalid:=False; //reset flag !
1246 ReleaseBitmap;
1247 If Bitmap = Nil Then Exit;
1248
1249 // make sure bitmap is updated
1250 Bitmap.Update;
1251
1252 If Bitmap.FBitmapMem = Nil Then Exit;
1253 If Bitmap.FBitmapMemLength = 0 Then Exit;
1254{
1255evtll wieder „ndern (falsch wenn Bitmap modifiziert durch Canvas
1256 BitmapStream.Create;
1257 BitmapStream.SetSize(Bitmap.FBitmapMemLength);
1258 Bitmap.SaveToStream(BitmapStream);
1259 BitmapStream.Position := 0;
1260 LoadFromStream(BitmapStream);
1261 BitmapStream.Destroy;
1262 FOrigin := Bitmap;
1263}
1264 LoadFromMem(Bitmap.FBitmapMem^,Bitmap.FBitmapMemLength);
1265End;
1266
1267
1268Function TBitmap.Copy:TBitmap;
1269Var locClass:TBitmapClass;
1270Begin
1271 locClass := ClassType;
1272 Result := locClass.Create;
1273 If Owner<>Nil Then
1274 Begin
1275 Result.Owner:=Owner;
1276 Owner.InsertComponent(Result);
1277 End;
1278 Result.LoadFromBitmap(Self);
1279End;
1280
1281Function TBitmap.CopyGraphic:TGraphic;
1282Begin
1283 Result:=Self.Copy
1284End;
1285
1286{$IFDEF OS2}
1287{$HINTS OFF}
1288Procedure TBitmap.RealizePalette(Canvas:TCanvas);
1289Begin
1290End;
1291{$HINTS ON}
1292
1293Procedure TBitmap.SetupBitmapColors(Header:Pointer;Mask:Boolean);
1294Type MyPRGB2=^PMyRGB2;
1295 PMyRGB2=Array[0..0] Of RGB2;
1296Var
1297 pbi2:PBITMAPINFO2;
1298 bIs1xFormat,bIs24BitColor:Boolean;
1299 pbi:PBITMAPINFO;
1300 lColorCount:LongInt;
1301 apRGB2:MyPRGB2;
1302 aNewRGB:MyPRGB2;
1303 I:LongInt;
1304 pal:LongWord;
1305Begin
1306 pbi2:=Header;
1307 bIs1xFormat := pbi2^.cbFix=SizeOf(BITMAPINFOHEADER);
1308
1309 {Get Colors Of Bitmap}
1310 If bIs1xFormat Then
1311 Begin
1312 pbi := Pointer(pbi2);
1313 lColorCount:= pbi^.cPlanes * (LongWord(1) Shl pbi^.cBitCount);
1314 bIs24BitColor:=pbi^.cBitCount=24;
1315 If Not Mask Then
1316 Begin
1317 FOrigPlanes:=pbi^.cPlanes;
1318 FOrigBitCount:=pbi^.cBitCount;
1319 End;
1320 End
1321 Else
1322 Begin
1323 If ((pbi2^.cbFix>64)And(pbi2^.cclrUsed>0)) Then lColorCount:=pbi2^.cclrUsed
1324 Else lColorCount:=pbi2^.cPlanes * (LongWord(1) Shl pbi2^.cBitCount);
1325 bIs24BitColor:=pbi2^.cBitCount=24;
1326 If Not Mask Then
1327 Begin
1328 FOrigPlanes:=pbi2^.cPlanes;
1329 FOrigBitCount:=pbi2^.cBitCount;
1330 End;
1331 End;
1332
1333 If Mask Then TIcon(Self).FMaskColorCount:=lColorCount
1334 Else FColorCount:=lColorCount;
1335
1336 (*
1337 If lColorCount<=16 Then
1338 Begin
1339 If Mask Then TIcon(Self).FMaskPal:=0
1340 Else FBitmapPal:=0;
1341 Exit; {??} {Create no Palette !}
1342 End;
1343 *)
1344
1345 If Not CreatePalette Then
1346 Begin
1347 If Mask Then TIcon(Self).FMaskPal:=0
1348 Else FBitmapPal:=0;
1349 Exit;
1350 End;
1351
1352 {Convert 1X color Table (RGB) To 2X format (RGB2)}
1353 If bIs1xFormat Then
1354 Begin
1355 GetMem(apRGB2,lColorCount*SizeOf(RGB2));
1356 pbi:=Pointer(pbi2);
1357 For I:=0 To lColorCount-1 Do
1358 Begin
1359 apRGB2^[I].bRed := pbi^.argbColor[I].bRed ;
1360 apRGB2^[I].bGreen := pbi^.argbColor[I].bGreen ;
1361 apRGB2^[I].bBlue := pbi^.argbColor[I].bBlue ;
1362 apRGB2^[I].fcOptions := 0 ;
1363 End;
1364 GetMem(aNewRGB,(lColorCount)*SizeOf(RGB2));
1365 Move(apRGB2^,aNewRGB^[0],lColorCount*SizeOf(RGB2));
1366 FreeMem(apRGB2,lColorCount*SizeOf(RGB2));
1367 apRGB2:=aNewRGB;
1368 End
1369 Else
1370 Begin
1371 apRGB2:=Pointer(pbi2);
1372 Inc(apRGB2,pbi2^.cbFix);
1373 GetMem(aNewRGB,(lColorCount)*SizeOf(RGB2));
1374 Move(apRGB2^,aNewRGB^[0],lColorCount*SizeOf(RGB2));
1375 apRGB2:=aNewRGB;
1376 End;
1377
1378 {Create A custom color Palette from color Info}
1379 pal := GpiCreatePalette(AppHandle,
1380 0{LCOL_OVERRIDE_DEFAULT_COLORS},
1381 LCOLF_CONSECRGB,
1382 lColorCount,
1383 apRGB2^);
1384
1385 If Mask Then TIcon(Self).FMaskColorCount:=lColorCount
1386 Else FColorCount:=lColorCount;
1387
1388 If Mask Then TIcon(Self).FMaskPal:=pal
1389 Else FBitmapPal:=pal;
1390
1391 {Set the Palette into ps before Bitmap creation}
1392 If Mask Then
1393 Begin
1394 If GpiSelectPalette(TIcon(Self).FMaskPS,TIcon(Self).FMaskPal) = PAL_ERROR Then InvalidImage;
1395 End
1396 Else
1397 Begin
1398 {GpiCreateLogColorTable(FBitmapPS,0,LCOLF_RGB,0,FColorCount,apRGB2^);}
1399 If GpiSelectPalette(FBitmapPS,FBitmapPal) = PAL_ERROR Then InvalidImage;
1400 GpiCreateLogColorTable(FBitmapPS,0,LCOLF_RGB,0,0,Nil);
1401 End;
1402
1403 FreeMem(apRGB2,lColorCount*SizeOf(RGB2));
1404End;
1405{$ENDIF}
1406
1407{$IFDEF Win95}
1408Procedure TBitmap.RealizePalette(Canvas:TCanvas);
1409Begin
1410 If FBitmapHandle=0 Then CreateHandle;
1411 If FBitmapPal<>0 Then
1412 Begin
1413 If Canvas=Nil Then
1414 Begin
1415 FOldPalette:=SelectPalette(FBitmapPS,FBitmapPal,True);
1416 WinGDI.RealizePalette(FBitmapPS);
1417 End
1418 Else
1419 Begin
1420 SelectPalette(Canvas.Handle,FBitmapPal,True);
1421 WinGDI.RealizePalette(Canvas.Handle);
1422 End;
1423 End;
1424End;
1425
1426Procedure TBitmap.SetupBitmapColors(Header:Pointer;Mask:Boolean);
1427Var Size,Size0,Size1:LongWord;
1428 PBC:^BitmapCoreHeader;
1429 pbi:^BITMAPINFOHEADER;
1430 BitmapInfo:PBitmapCoreInfo;
1431 P:^Byte;
1432 Colors,T:LongInt;
1433 DestPal:PLogPalette;
1434 BitmapInfo1:PBITMAPINFO;
1435 Focus:HWND;
1436 ADC,MemDC:HDC;
1437 SysPalSize:LongInt;
1438 I:LongInt;
1439 FTempBmp,FOldTempBmp:LongWord;
1440Label Win;
1441Begin
1442 If Not (Self Is TIcon) Then
1443 Begin
1444 PBC:=Header;
1445 If PBC^.bcSize=SizeOf(BitmapCoreHeader) Then
1446 Begin
1447 {OS2 Bitmap}
1448 Size:=(1 Shl PBC^.bcBitCount) * SizeOf(RGBTriple);
1449 Size0:=Size + SizeOf(BitmapCoreInfo);
1450 GetMem(BitmapInfo,Size0);
1451 BitmapInfo^.bmciHeader:=PBC^;
1452 P:=Header;
1453 Inc(P,SizeOf(BitmapCoreHeader));
1454 Move(P^,BitmapInfo^.bmciColors,Size);
1455 Colors:=1 Shl PBC^.bcBitCount;
1456 FColorCount:=Colors;
1457 If Not Mask Then
1458 Begin
1459 FOrigBitCount:=PBC^.bcBitCount;
1460 FOrigPlanes:=PBC^.bcPlanes;
1461 End;
1462
1463 If Colors<=2 Then
1464 Begin
1465 If Mask Then TIcon(Self).FMaskPal:=0
1466 Else FBitmapPal:=0;
1467 Exit;
1468 End;
1469
1470 Size1 := SizeOf(LogPalette) + ((Colors - 1) * SizeOf(PaletteEntry));
1471 GetMem(DestPal,Size1);
1472 FillChar(DestPal^,Size1,0);
1473 With DestPal^ Do
1474 Begin
1475 palVersion := $300;
1476 palNumEntries := Colors;
1477
1478 For T:=0 To Colors - 1 Do
1479 Begin
1480 If BitmapInfo^.bmciColors[T].rgbtRed=204 Then
1481 If BitmapInfo^.bmciColors[T].rgbtGreen=204 Then
1482 If BitmapInfo^.bmciColors[T].rgbtBlue=204 Then
1483 Begin
1484 BitmapInfo^.bmciColors[T].rgbtRed:=192;
1485 BitmapInfo^.bmciColors[T].rgbtGreen:=192;
1486 BitmapInfo^.bmciColors[T].rgbtBlue:=192;
1487 End;
1488
1489 palPalEntry[T].peRed := BitmapInfo^.bmciColors[T].rgbtRed;
1490 palPalEntry[T].peGreen := BitmapInfo^.bmciColors[T].rgbtGreen;
1491 palPalEntry[T].peBlue := BitmapInfo^.bmciColors[T].rgbtBlue;
1492 palPalEntry[T].peFlags := 0;
1493 End;
1494 End;
1495 Move(BitmapInfo^.bmciColors,P^,Size);
1496 If Mask Then TIcon(Self).FMaskPal:=WinGDI.CreatePalette(DestPal^)
1497 Else FBitmapPal:=WinGDI.CreatePalette(DestPal^);
1498
1499 FreeMem(DestPal,Size1);
1500 FreeMem(BitmapInfo,Size0);
1501 End
1502 Else If PBC^.bcSize=SizeOf(BITMAPINFOHEADER) Then
1503 Begin
1504 {Win Bitmap}
1505 pbi:=Pointer(PBC);
1506Win:
1507 Size:=(1 Shl pbi^.biBitCount) * SizeOf(RGBQuad);
1508 Size0:=Size+SizeOf(BITMAPINFOHEADER);
1509 GetMem(BitmapInfo1,Size0);
1510 BitmapInfo1^.bmiHeader:=pbi^;
1511 P:=Header;
1512 Inc(P,SizeOf(BITMAPINFOHEADER));
1513 Move(P^,BitmapInfo1^.bmiColors,Size);
1514 Colors:=1 Shl pbi^.biBitCount;
1515 FColorCount:=Colors;
1516 If Not Mask Then
1517 Begin
1518 FOrigPlanes:=pbi^.biPlanes;
1519 FOrigBitCount:=pbi^.biBitCount;
1520 End;
1521
1522 If Colors<=2 Then
1523 Begin
1524 If Mask Then TIcon(Self).FMaskPal:=0
1525 Else FBitmapPal:=0;
1526 Exit;
1527 End;
1528
1529 Size1:=SizeOf(LogPalette)+((Colors-1)*SizeOf(PaletteEntry));
1530 GetMem(DestPal,Size1);
1531 FillChar(DestPal^,Size1,0);
1532
1533 With DestPal^ Do
1534 Begin
1535 palVersion := $300;
1536 palNumEntries := Colors;
1537
1538 ADC:=GetDC(0);
1539 MemDC:=CreateCompatibleDC(ADC);
1540 FTempBmp:=CreateCompatibleBitmap(ADC,1,1);
1541 FOldTempBmp:=SelectObject(MemDC,FTempBmp);
1542
1543 SysPalSize := GetDeviceCaps(MemDC, SIZEPALETTE);
1544 If ((Colors=16)And(SysPalSize>=16)) Then
1545 Begin
1546 GetSystemPaletteEntries(MemDC,0,8,palPalEntry[0]);
1547 I := 8;
1548 GetSystemPaletteEntries(MemDC,SysPalSize-I,I,palPalEntry[I]);
1549 For T:=0 To 7 Do
1550 Begin
1551 If palPalEntry[T].peRed=204 Then
1552 If palPalEntry[T].peGreen=204 Then
1553 If palPalEntry[T].peBlue=204 Then
1554 Begin
1555 palPalEntry[T].peRed:=192;
1556 palPalEntry[T].peGreen:=192;
1557 palPalEntry[T].peBlue:=192;
1558 End;
1559 End;
1560 End
1561 Else
1562 Begin
1563 For T:=0 To Colors-1 Do
1564 Begin
1565 If BitmapInfo1^.bmiColors[T].rgbRed=204 Then
1566 If BitmapInfo1^.bmiColors[T].rgbGreen=204 Then
1567 If BitmapInfo1^.bmiColors[T].rgbBlue=204 Then
1568 Begin
1569 BitmapInfo1^.bmiColors[T].rgbRed:=192;
1570 BitmapInfo1^.bmiColors[T].rgbGreen:=192;
1571 BitmapInfo1^.bmiColors[T].rgbBlue:=192;
1572 End;
1573
1574 palPalEntry[T].peRed:=BitmapInfo1^.bmiColors[T].rgbRed;
1575 palPalEntry[T].peGreen:=BitmapInfo1^.bmiColors[T].rgbGreen;
1576 palPalEntry[T].peBlue:=BitmapInfo1^.bmiColors[T].rgbBlue;
1577 palPalEntry[T].peFlags := 0;
1578 End;
1579 End;
1580
1581 SelectObject(MemDC,FOldTempBmp);
1582 If not DeleteObject(FTempBmp) Then InvalidImage;
1583 If MemDC<>0 Then If not DeleteDC(MemDC) Then InvalidImage;
1584 If ADC<>0 Then If ReleaseDC(0,ADC)=0 Then InvalidImage;
1585 End;
1586 Move(BitmapInfo1^.bmiColors,P^,Size);
1587 If Mask Then TIcon(Self).FMaskPal:=WinGDI.CreatePalette(DestPal^)
1588 Else FBitmapPal:= WinGDI.CreatePalette(DestPal^);
1589
1590 FreeMem(DestPal,Size1);
1591 FreeMem(BitmapInfo1,Size0);
1592 End
1593 Else InvalidImage;
1594 End
1595 Else //Icon Or Pointer
1596 Begin
1597 pbi:=Header;
1598 Goto Win;
1599 End;
1600End;
1601{$ENDIF}
1602
1603// Turn a specified set of data into an OS bitmap
1604{$HINTS OFF}
1605Procedure TBitmap.NewImage(BitmapData:Pointer;BitmapSize,OffsBits:LongWord;Mask:Boolean);
1606{$IFDEF OS2}
1607Var
1608 pbih:PBITMAPINFOHEADER;
1609 pbih2:PBITMAPINFOHEADER2;
1610 bih2:BITMAPINFOHEADER2;
1611 pbi2:PBITMAPINFO2;
1612 sizl:SIZEL;
1613 dop:DEVOPENSTRUC;
1614 pc:cstring;
1615 cScans,cScansRet,CX,CY:ULONG;
1616 Temp:^Byte;
1617 DC:LongWord;
1618 ps:LongWord;
1619 H:LongWord;
1620{$ENDIF}
1621{$IFDEF Win95}
1622Var
1623 PBC:^BitmapCoreHeader;
1624 pbi:^BITMAPINFOHEADER;
1625 BitmapInfo:PBitmapCoreInfo;
1626 BitmapInfo1:PBITMAPINFO;
1627 Size,Size0:LongWord;
1628 P:^Byte;
1629 Bits:Pointer;
1630 Focus:HWND;
1631 ADC,aDC1,MemDC,MemDC1:HDC;
1632 OldPal:LongWord;
1633 FTempBmp,FTempBmp1:LongWord;
1634 FOldTempBmp,FOldTempBmp1:LongWord;
1635{$ENDIF}
1636Begin
1637 {$IFDEF OS2}
1638 FillChar(dop,SizeOf(DEVOPENSTRUC),0);
1639 pc:='DISPLAY';
1640 dop.pszDriverName:=@pc;
1641 DC := DevOpenDC(AppHandle,OD_MEMORY,'*',3,dop,0);
1642 If DC=0 Then InvalidImage;
1643
1644 If Mask Then TIcon(Self).FMaskDC:=DC
1645 Else FBitmapDC:=DC;
1646
1647 sizl.CX := 1;
1648 sizl.CY := 1;
1649 ps := GpiCreatePS(AppHandle,DC,sizl,PU_PELS Or GPIA_ASSOC Or GPIT_MICRO);
1650 If ps = GPI_ERROR Then InvalidImage;
1651
1652 If Mask Then TIcon(Self).FMaskPS:=ps
1653 Else FBitmapPS:=ps;
1654
1655 {If Not Mask Then} GpiCreateLogColorTable(ps,LCOL_RESET,LCOLF_RGB,0,0,Nil);
1656
1657 pbih2:=BitmapData;
1658
1659 If pbih2^.cbFix = SizeOf(BITMAPINFOHEADER) Then
1660 Begin
1661 { old format }
1662 pbih := Pointer(pbih2);
1663 cScans := pbih^.CY;
1664 CX := pbih^.CX;
1665 CY := pbih^.CY;
1666 End
1667 Else
1668 Begin
1669 { New PM format, windows, Or other }
1670 cScans := pbih2^.CY;
1671 CX := pbih2^.CX;
1672 CY := pbih2^.CY;
1673 End;
1674
1675 {If Not Mask Then} SetupBitmapColors(BitmapData,Mask);
1676
1677 Move(pbih2^, bih2, pbih2^.cbFix); { Copy Info into global structure }
1678
1679 H:=GpiCreateBitmap(ps,bih2,0,Nil,Nil);
1680 If H=0 Then InvalidImage;
1681
1682 If Mask Then TIcon(Self).FMaskHandle:=H
1683 Else FBitmapHandle:=H;
1684
1685 If GpiSetBitmap(ps,H) = BMB_ERROR Then InvalidImage;
1686
1687 If ((BitmapData<>Nil) And (CX>0) And (CY>0)) Then
1688 Begin
1689 pbih:=BitmapData;
1690 Temp:=Pointer(pbih);
1691 Inc(Temp,OffsBits);
1692 pbi2:=Pointer(pbih);
1693 cScansRet := GpiSetBitmapBits(ps,0,cScans,Temp^,pbi2^);
1694 If cScansRet <> cScans Then InvalidImage; { original # Of scans? }
1695 FEmpty:=False;
1696 End
1697 Else InvalidImage;
1698 {$ENDIF}
1699 {$IFDEF Win95}
1700 If Not (Self Is TIcon) Then
1701 Begin
1702 PBC:=BitmapData;
1703 If PBC^.bcSize=SizeOf(BitmapCoreHeader) Then
1704 Begin
1705 {OS2 Bitmap}
1706 If PBC^.bcPlanes<>1 Then InvalidImage;
1707 If FBitmapPal=0 Then
1708 SetupBitmapColors(BitmapData,Mask);
1709
1710 Size:=(1 Shl PBC^.bcBitCount) * SizeOf(RGBTriple);
1711 Size0:=Size + SizeOf(BitmapCoreInfo);
1712 GetMem(BitmapInfo,Size0);
1713 BitmapInfo^.bmciHeader:=PBC^;
1714 P:=BitmapData;
1715 Inc(P,SizeOf(BitmapCoreHeader));
1716 Move(P^,BitmapInfo^.bmciColors,Size);
1717
1718 P:=BitmapData;
1719 Inc(P,SizeOf(BitmapCoreHeader));
1720 Inc(P,FColorCount*SizeOf(RGBTriple));
1721 Size:=((((FWidth*PBC^.bcBitCount)+31) Div 32)*4)*FHeight;
1722 GetMem(Bits,Size);
1723 Move(P^,Bits^,Size);
1724
1725 ADC:=GetDC(0);
1726 MemDC:=CreateCompatibleDC(ADC);
1727 FTempBmp:=CreateCompatibleBitmap(ADC,1,1);
1728 FOldTempBmp:=SelectObject(MemDC,FTempBmp);
1729
1730 If FBitmapPal<> 0 Then
1731 Begin
1732 OldPal := SelectPalette(MemDC,FBitmapPal,False);
1733 WinGDI.RealizePalette(MemDC);
1734 End
1735 Else OldPal:=0;
1736
1737 FBitmapHandle:=CreateDIBitmap(MemDC,PBITMAPINFOHEADER(PBC)^,
1738 CBM_INIT,Bits^,PBITMAPINFO(BitmapInfo)^,
1739 DIB_RGB_COLORS);
1740 If FBitmapHandle=0 Then InvalidImage;
1741
1742 If OldPal<>0 Then SelectPalette(MemDC,OldPal,True);
1743 SelectObject(MemDC,FOldTempBmp);
1744 If not DeleteObject(FTempBmp) Then InvalidImage;
1745 if MemDC <> 0 then If not DeleteDC(MemDC) Then InvalidImage;
1746 If ADC<>0 Then If ReleaseDC(0,ADC)=0 Then InvalidImage;
1747
1748 FreeMem(BitmapInfo,Size0);
1749 FreeMem(Bits,Size);
1750 End
1751 Else If PBC^.bcSize=SizeOf(BITMAPINFOHEADER) Then
1752 Begin
1753 {Win Bitmap}
1754 pbi:=BitmapData;
1755 If pbi^.biPlanes<>1 Then InvalidImage;
1756 If FBitmapPal=0 Then
1757 SetupBitmapColors(BitmapData,Mask);
1758
1759 Size:=(1 Shl pbi^.biBitCount) * SizeOf(RGBQuad);
1760 Size0:=Size+SizeOf(BITMAPINFOHEADER);
1761 GetMem(BitmapInfo1,Size0);
1762 BitmapInfo1^.bmiHeader:=pbi^;
1763 P:=BitmapData;
1764 Inc(P,SizeOf(BITMAPINFOHEADER));
1765 Move(P^,BitmapInfo1^.bmiColors,Size);
1766
1767 P:=BitmapData;
1768 Inc(P,SizeOf(BITMAPINFOHEADER));
1769 Inc(P,FColorCount*SizeOf(RGBQuad));
1770 Size:=pbi^.biSizeImage;
1771 GetMem(Bits,Size);
1772 Move(P^,Bits^,Size);
1773
1774 ADC:=GetDC(0);
1775 MemDC:=CreateCompatibleDC(ADC);
1776 FTempBmp:=CreateCompatibleBitmap(ADC,1,1);
1777 FOldTempBmp:=SelectObject(MemDC,FTempBmp);
1778
1779 If FBitmapPal<>0 Then
1780 Begin
1781 OldPal:=SelectPalette(MemDC,FBitmapPal,False);
1782 WinGDI.RealizePalette(MemDC);
1783 End
1784 Else OldPal := 0;
1785
1786 FBitmapHandle:=CreateDIBitmap(MemDC,pbi^,CBM_INIT,Bits^,
1787 BitmapInfo1^,DIB_RGB_COLORS);
1788 If FBitmapHandle=0 Then InvalidImage;
1789
1790 If OldPal<>0 Then SelectPalette(MemDC,OldPal,True);
1791 SelectObject(MemDC,FOldTempBmp);
1792 If not DeleteObject(FTempBmp) Then InvalidImage;
1793 if MemDC <> 0 then If not DeleteDC(MemDC) Then InvalidImage;
1794 If ADC<>0 Then If ReleaseDC(0,ADC)=0 Then InvalidImage;
1795
1796 FreeMem(BitmapInfo1,Size0);
1797 FreeMem(Bits,Size);
1798 End
1799 Else InvalidImage;
1800
1801 FEmpty:=False;
1802 End
1803 Else //Icon Or Pointer
1804 Begin
1805 PBC:=BitmapData;
1806 If PBC^.bcSize=SizeOf(BitmapCoreHeader) Then //OS2 Icon
1807 Begin
1808 If PBC^.bcPlanes<>1 Then InvalidImage;
1809 {OS2 Icon}
1810 If Mask Then
1811 Begin
1812 //Create Xor Mask
1813 If FBitmapPal=0 Then SetupBitmapColors(BitmapData,Mask);
1814
1815 P:=BitmapData;
1816 Inc(P,OffsBits);
1817
1818 Size:=2 * SizeOf(RGBTriple);
1819 Size0:=Size+SizeOf(BitmapCoreInfo);
1820 GetMem(BitmapInfo,Size0);
1821 BitmapInfo^.bmciHeader:=PBC^;
1822
1823 BitmapInfo^.bmciHeader.bcBitCount:=1;
1824 BitmapInfo^.bmciHeader.bcPlanes:=1;
1825 BitmapInfo^.bmciColors[0].rgbtBlue:=0;
1826 BitmapInfo^.bmciColors[0].rgbtGreen:=0;
1827 BitmapInfo^.bmciColors[0].rgbtRed:=0;
1828 BitmapInfo^.bmciColors[1].rgbtBlue:=255;
1829 BitmapInfo^.bmciColors[1].rgbtGreen:=255;
1830 BitmapInfo^.bmciColors[1].rgbtRed:=255;
1831
1832 ADC:=GetDC(0);
1833 MemDC:=CreateCompatibleDC(ADC);
1834 FTempBmp:=CreateCompatibleBitmap(ADC,1,1);
1835 FOldTempBmp:=SelectObject(MemDC,FTempBmp);
1836
1837 If TIcon(Self).FMaskPal<> 0 Then
1838 Begin
1839 OldPal := SelectPalette(MemDC,TIcon(Self).FMaskPal,False);
1840 WinGDI.RealizePalette(MemDC);
1841 End
1842 Else OldPal:=0;
1843
1844 TIcon(Self).FMaskHandle:=CreateDIBitmap(MemDC,PBITMAPINFOHEADER(PBC)^,
1845 CBM_INIT,P^,PBITMAPINFO(BitmapInfo)^,
1846 DIB_RGB_COLORS);
1847 If TIcon(Self).FMaskHandle=0 Then InvalidImage;
1848
1849 If OldPal<>0 Then SelectPalette(MemDC,OldPal,True);
1850 SelectObject(MemDC,FOldTempBmp);
1851 If not DeleteObject(FTempBmp) Then InvalidImage;
1852 if MemDC <> 0 then If not DeleteDC(MemDC) Then InvalidImage;
1853 If ADC<>0 Then If ReleaseDC(0,ADC)=0 Then InvalidImage;
1854
1855 FreeMem(BitmapInfo,Size0);
1856
1857 TIcon(Self).FMaskPS:=CreateCompatibleDC(0);
1858 TIcon(Self).FOldMaskBitmap:=SelectObject(TIcon(Self).FMaskPS,TIcon(Self).FMaskHandle);
1859 End
1860 Else
1861 Begin
1862 If FBitmapPal=0 Then SetupBitmapColors(BitmapData,Mask);
1863
1864 Size:=(1 Shl PBC^.bcBitCount) * SizeOf(RGBTriple);
1865 Size0:=Size + SizeOf(BitmapCoreInfo);
1866 GetMem(BitmapInfo,Size0);
1867 BitmapInfo^.bmciHeader:=PBC^;
1868 P:=BitmapData;
1869 Inc(P,SizeOf(BitmapCoreHeader));
1870 Move(P^,BitmapInfo^.bmciColors,Size);
1871
1872 P:=BitmapData;
1873 Inc(P,OffsBits);
1874 Size:=((((FWidth*PBC^.bcBitCount)+31) Div 32)*4)*FHeight;
1875 GetMem(Bits,Size);
1876 Move(P^,Bits^,Size);
1877
1878 ADC:=GetDC(0);
1879 MemDC:=CreateCompatibleDC(ADC);
1880 FTempBmp:=CreateCompatibleBitmap(ADC,1,1);
1881 FOldTempBmp:=SelectObject(MemDC,FTempBmp);
1882
1883 If FBitmapPal<> 0 Then
1884 Begin
1885 OldPal := SelectPalette(MemDC,FBitmapPal,False);
1886 WinGDI.RealizePalette(MemDC);
1887 End
1888 Else OldPal:=0;
1889
1890 FBitmapHandle:=CreateDIBitmap(MemDC,PBITMAPINFOHEADER(PBC)^,
1891 CBM_INIT,Bits^,PBITMAPINFO(BitmapInfo)^,
1892 DIB_RGB_COLORS);
1893 If FBitmapHandle=0 Then InvalidImage;
1894
1895 If OldPal<>0 Then SelectPalette(MemDC,OldPal,True);
1896 SelectObject(MemDC,FOldTempBmp);
1897 If not DeleteObject(FTempBmp) Then InvalidImage;
1898 if MemDC <> 0 then If not DeleteDC(MemDC) Then InvalidImage;
1899 If ADC<>0 Then If ReleaseDC(0,ADC)=0 Then InvalidImage;
1900
1901 FreeMem(BitmapInfo,Size0);
1902 FreeMem(Bits,Size);
1903
1904 FEmpty:=False;
1905 End;
1906 End
1907 Else //Win Icon
1908 Begin
1909 pbi:=BitmapData;
1910
1911 If pbi^.biPlanes<>1 Then InvalidImage;
1912 If FBitmapPal=0 Then SetupBitmapColors(BitmapData,Mask);
1913
1914 Size:=(1 Shl pbi^.biBitCount) * SizeOf(RGBQuad);
1915 Size0:=Size+SizeOf(BITMAPINFOHEADER);
1916 GetMem(BitmapInfo1,Size0);
1917 BitmapInfo1^.bmiHeader:=pbi^;
1918
1919 BitmapInfo1^.bmiHeader.biHeight:=BitmapInfo1^.bmiHeader.biHeight Div 2;
1920 BitmapInfo1^.bmiHeader.biSizeImage:=
1921 (((BitmapInfo1^.bmiHeader.biBitCount*BitmapInfo1^.bmiHeader.biWidth)+31) Div 32)*4*
1922 BitmapInfo1^.bmiHeader.biHeight*BitmapInfo1^.bmiHeader.biPlanes;
1923
1924 P:=BitmapData;
1925 Inc(P,SizeOf(BITMAPINFOHEADER));
1926 Move(P^,BitmapInfo1^.bmiColors,Size);
1927
1928 P:=BitmapData;
1929 Inc(P,SizeOf(BITMAPINFOHEADER));
1930 Inc(P,FColorCount*SizeOf(RGBQuad));
1931 Size:=BitmapInfo1^.bmiHeader.biSizeImage;
1932 GetMem(Bits,Size);
1933 Move(P^,Bits^,Size);
1934
1935 ADC:=GetDC(0);
1936 MemDC:=CreateCompatibleDC(ADC);
1937 FTempBmp:=CreateCompatibleBitmap(ADC,1,1);
1938 FOldTempBmp:=SelectObject(MemDC,FTempBmp);
1939
1940 If FBitmapPal<>0 Then
1941 Begin
1942 OldPal:=SelectPalette(MemDC,FBitmapPal,False);
1943 WinGDI.RealizePalette(MemDC);
1944 End
1945 Else OldPal := 0;
1946
1947 //Create Xor Mask
1948 FBitmapHandle:=CreateDIBitmap(MemDC,BitmapInfo1^.bmiHeader,CBM_INIT,Bits^,
1949 BitmapInfo1^,DIB_RGB_COLORS);
1950 If FBitmapHandle=0 Then InvalidImage;
1951
1952 //Create And Mask
1953 Inc(P,Size);
1954 //Move(P^,Bits^,Size);
1955 BitmapInfo1^.bmiHeader.biBitCount:=1;
1956 BitmapInfo1^.bmiHeader.biPlanes:=1;
1957 BitmapInfo1^.bmiHeader.biSizeImage:=
1958 (((BitmapInfo1^.bmiHeader.biBitCount*BitmapInfo1^.bmiHeader.biWidth)+31) Div 32)*4*
1959 BitmapInfo1^.bmiHeader.biHeight*BitmapInfo1^.bmiHeader.biPlanes;
1960 BitmapInfo1^.bmiColors[1].rgbBlue:=255;
1961 BitmapInfo1^.bmiColors[1].rgbGreen:=255;
1962 BitmapInfo1^.bmiColors[1].rgbRed:=255;
1963
1964 ADC1:=GetDC(0);
1965 MemDC1:=CreateCompatibleDC(ADC1);
1966 FTempBmp1:=CreateCompatibleBitmap(ADC1,1,1);
1967 FOldTempBmp1:=SelectObject(MemDC1,FTempBmp1);
1968
1969 TIcon(Self).FMaskHandle:=CreateDIBitmap(MemDC1,BitmapInfo1^.bmiHeader,CBM_INIT,P^,
1970 BitmapInfo1^,DIB_RGB_COLORS);
1971 If TIcon(Self).FMaskHandle=0 Then InvalidImage;
1972
1973 If OldPal<>0 Then SelectPalette(MemDC,OldPal,True);
1974 SelectObject(MemDC,FOldTempBmp);
1975 If not DeleteObject(FTempBmp) Then InvalidImage;
1976 if MemDC <> 0 then If not DeleteDC(MemDC) Then InvalidImage;
1977 If ADC<>0 Then If ReleaseDC(0,ADC)=0 Then InvalidImage;
1978
1979 SelectObject(MemDC1,FOldTempBmp1);
1980 If not DeleteObject(FTempBmp1) Then InvalidImage;
1981 if MemDC1 <> 0 then If not DeleteDC(MemDC1) Then InvalidImage;
1982 If ADC1<>0 Then If ReleaseDC(0,ADC1)=0 Then InvalidImage;
1983
1984 FreeMem(BitmapInfo1,Size0);
1985 FreeMem(Bits,Size);
1986
1987 TIcon(Self).FMaskPS:=CreateCompatibleDC(0);
1988 TIcon(Self).FOldMaskBitmap:=SelectObject(TIcon(Self).FMaskPS,TIcon(Self).FMaskHandle);
1989 End;
1990 FEmpty:=False;
1991 End;
1992 {$ENDIF}
1993End;
1994{$HINTS ON}
1995
1996Procedure TBitmap.InvalidImage;
1997Begin
1998 FIsInvalid:=True;
1999 ReleaseBitmap;
2000 Raise EInvalidBitmap.Create(LoadNLSStr(SInvalidBitmap));
2001End;
2002
2003Type
2004 ICONDIRENTRY=Record
2005 bWidth:Byte;
2006 bHeight:Byte;
2007 bColorCount:Byte;
2008 bReserved:Byte;
2009 wPlanes:Word;
2010 wBitCount:Word;
2011 dwBytesInRes:LongWord;
2012 dwImageOffset:LongWord;
2013 End;
2014
2015Type PICONDIR=^TICONDIR;
2016 TICONDIR=Record
2017 idReserved:Word;
2018 idType:Word;
2019 idCount:Word;
2020 idEntries:ICONDIRENTRY;
2021 End;
2022
2023// Converts the data in memory (FBitmapMem) into an OS bitmap
2024// or two if a mask (icon) is involved. Calls NewImage to create the OS bitmaps
2025Procedure TBitmap.SetupBitmap;
2026{$IFDEF OS2}
2027Var
2028 pbBuffer:Pointer;
2029 pbafh2 : PBITMAPARRAYFILEHEADER2;
2030 pbfh2 : PBITMAPFILEHEADER2;
2031 pbih : PBITMAPINFOHEADER;
2032 pbih2 : PBITMAPINFOHEADER2;
2033 I,J,Bitmap2 : Word;
2034 BitmapOffset:LongWord;
2035 BitmapData:Pointer;
2036 BitmapSize,OffsBits:LongWord;
2037 Size:LongWord;
2038 MaskHeader:PBITMAPFILEHEADER2;
2039// ID:PIconDir;
2040Label LL;
2041{$ENDIF}
2042{$IFDEF Win95}
2043Var
2044 pbBuffer:Pointer;
2045 PBC:^BitmapCoreHeader;
2046 pbi:^BITMAPINFOHEADER;
2047 BitmapOffset,OffsBits,BitmapSize:LongWord;
2048 BitmapData:Pointer;
2049 ResHandle:LongWord;
2050 Size:LongWord;
2051 iDir:PICONDIR;
2052 bfh:PBITMAPFILEHEADER;
2053 MaskHeader:PBITMAPFILEHEADER;
2054 I,J,Bitmap2 : Word;
2055 WithFileHeader:Boolean;
2056Const
2057 BFT_COLORICON =$4943; { 'CI' }
2058 BFT_COLORPOINTER =$5043; { 'CP' }
2059 BFT_BITMAP =$4d42; { 'BM' }
2060Label check,ProcessIcon;
2061{$ENDIF}
2062Begin
2063 {$IFDEF OS2}
2064 pbBuffer:=FBitmapMem;
2065 Size:=FBitmapMemLength;
2066 MaskHeader:=Nil;
2067
2068 pbfh2 := pbBuffer;
2069 pbih2 := Nil; { only Set This when we validate Type }
2070
2071 If pbfh2^.usType = BFT_BITMAPARRAY Then
2072 Begin
2073 If Not (Self Is TBitmap) Then InvalidImage;
2074 pbafh2 := @pbBuffer^;
2075 pbfh2 := @pbafh2^.bfh2;
2076 End;
2077
2078 FXHotSpot:=pbfh2^.XHotSpot;
2079 FYHotSpot:=pbfh2^.YHotSpot;
2080
2081 Case pbfh2^.usType Of
2082 BFT_BMAP:
2083 Begin
2084 If Not (Self Is TBitmap) Then InvalidImage;
2085 pbih2 := @pbfh2^.bmp2;
2086 End;
2087 {
2088 0: //Win 3.1 icon ?
2089 Begin
2090 ID:=Pointer(pbfh2);
2091 If ID.idType<>1 Then InvalidImage;
2092
2093 //Win 3.1 Icon found
2094 inc(ID,$16); //Offset to BITMAPINFOHEADER
2095 pbih2:=Pointer(ID);
2096 Icon hat doppelte H”he (64)
2097 End;
2098 }
2099 {
2100 BFT_ICON:
2101 Begin
2102 If Not (Self Is TIcon) Then InvalidImage;
2103 pbih2 := @pbfh2^.bmp2;
2104 End;
2105 BFT_POINTER:
2106 Begin
2107 If Not (Self Is TPointer) Then InvalidImage;
2108 pbih2 := @pbfh2^.bmp2;
2109 End;
2110 }
2111 BFT_COLORICON,
2112 BFT_COLORPOINTER :
2113 Begin
2114 If Not (Self Is TPointer) Then
2115 If Not (Self Is TIcon) Then InvalidImage;
2116
2117 MaskHeader:=pbfh2;
2118 If pbfh2^.cbSize = SizeOf(BITMAPFILEHEADER) Then
2119 Begin
2120 pbih := @pbfh2^.bmp2; {only BITMAPINFOHEADER}
2121 J := 1;
2122 For I := 1 To (pbih^.cPlanes*pbih^.cBitCount) Do J := 2*J;
2123 Bitmap2 := SizeOf(RGB)*J; {Size Of color Table}
2124 End
2125 Else
2126 Begin
2127 pbih2 := @pbfh2^.bmp2; {BITMAPINFOHEADER2}
2128 J := 1;
2129 For I := 1 To (pbih2^.cPlanes*pbih2^.cBitCount) Do J := 2*J;
2130 Bitmap2 := SizeOf(RGB2)*J; {Size Of color Table}
2131 End;
2132 Inc(Bitmap2,pbfh2^.cbSize); {+ Size Of BITMAPFILEHEADER[2]}
2133 Inc(pbfh2,Bitmap2); {Select the Second Bitmap}
2134 pbih2 := @pbfh2^.bmp2;
2135 End;
2136 End; {Case}
2137
2138 If pbih2 = Nil Then
2139 Begin
2140LL:
2141 InvalidImage;
2142 End;
2143
2144 BitmapOffset:=LongWord(pbih2)-LongWord(@pbBuffer^);
2145 BitmapSize:=Size-BitmapOffset;
2146
2147 BitmapData:=pbih2;
2148
2149 If pbih2^.cbFix=SizeOf(BITMAPINFOHEADER) Then
2150 Begin
2151 {old format}
2152 FWidth:=PBITMAPINFOHEADER(pbih2)^.CX;
2153 FHeight:=PBITMAPINFOHEADER(pbih2)^.CY;
2154 End
2155 Else
2156 Begin
2157 {New PM format Or other}
2158 FWidth:=pbih2^.CX;
2159 FHeight:=pbih2^.CY;
2160 End;
2161
2162 OffsBits:=pbfh2^.offBits-BitmapOffset;
2163
2164 NewImage(BitmapData,BitmapSize,OffsBits,False);
2165
2166 If Self Is TIcon Then If MaskHeader<>Nil Then
2167 Begin
2168 pbfh2:=MaskHeader;
2169 pbih2:=@pbfh2^.bmp2;
2170
2171 BitmapOffset:=LongWord(pbih2)-LongWord(@pbBuffer^);
2172 BitmapSize:=Size-BitmapOffset;
2173
2174 BitmapData:=pbih2;
2175
2176 If pbih2^.cbFix=SizeOf(BITMAPINFOHEADER) Then
2177 Begin
2178 {old format}
2179 TIcon(Self).FMaskWidth:=PBITMAPINFOHEADER(pbih2)^.CX;
2180 TIcon(Self).FMaskHeight:=PBITMAPINFOHEADER(pbih2)^.CY;
2181 End
2182 Else
2183 Begin
2184 {New PM format Or other}
2185 TIcon(Self).FMaskWidth:=pbih2^.CX;
2186 TIcon(Self).FMaskHeight:=pbih2^.CY;
2187 End;
2188
2189 OffsBits:=pbfh2^.offBits-BitmapOffset;
2190
2191 NewImage(BitmapData,BitmapSize,OffsBits,True);
2192 End;
2193 {$ENDIF}
2194 {$IFDEF Win95}
2195 pbBuffer:=FBitmapMem;
2196
2197 If Not (Self Is TIcon) Then
2198 Begin
2199 PBC:=pbBuffer;
2200check:
2201 If PBC^.bcSize=SizeOf(BitmapCoreHeader) Then
2202 Begin
2203 FWidth:=PBC^.bcWidth;
2204 FHeight:=PBC^.bcHeight;
2205 End
2206 Else If PBC^.bcSize=SizeOf(BITMAPINFOHEADER) Then
2207 Begin
2208 pbi:=Pointer(PBC);
2209 FWidth:=pbi^.biWidth;
2210 FHeight:=pbi^.biHeight;
2211 End
2212 Else
2213 Begin
2214 bfh:=pbBuffer;
2215 If bfh^.bfType=BFT_BITMAP Then
2216 Begin
2217 PBC:=pbBuffer;
2218 inc(PBC,sizeof(BITMAPFILEHEADER));
2219 goto check;
2220 End
2221 Else InvalidImage;
2222 End;
2223
2224 BitmapOffset:=0;
2225 OffsBits:=0;{PBmf^.bfOffBits-BitmapOffset;} //Not used For Win
2226 BitmapSize:=FBitmapMemLength;
2227 BitmapData:=PBC;
2228 NewImage(BitmapData,BitmapSize,OffsBits,False);
2229 End
2230 Else //Icon Or Pointer
2231 Begin
2232 bfh:=pbBuffer;
2233
2234 If ((bfh^.bfType=BFT_COLORICON)Or
2235 (bfh^.bfType=BFT_COLORPOINTER)) Then //OS/2 Icon
2236 Begin
2237 {
2238 FXHotSpot:=pbfh^.XHotSpot;
2239 FYHotSpot:=pbfh^.YHotSpot;}
2240 WithFileHeader:=True;
2241ProcessIcon:
2242 MaskHeader:=bfh;
2243 PBC:=pbBuffer;
2244 If WithFileHeader Then Inc(PBC,SizeOf(BITMAPFILEHEADER));
2245 If PBC^.bcSize<>SizeOf(BitmapCoreHeader) Then InvalidImage;
2246 J := 1;
2247 For I := 1 To (PBC^.bcPlanes*PBC^.bcBitCount) Do J := 2*J;
2248 Bitmap2 := SizeOf(RGBTriple)*J; {Size Of color Table}
2249 Inc(Bitmap2,SizeOf(BITMAPFILEHEADER)); {+ Size Of BITMAPFILEHEADER[2]}
2250 Inc(Bitmap2,SizeOf(BitmapCoreHeader));
2251
2252 Inc(bfh,Bitmap2);
2253 PBC := Pointer(bfh); {Select the Second Bitmap}
2254 If WithFileHeader Then Inc(PBC,SizeOf(BITMAPFILEHEADER));
2255 If PBC^.bcSize<>SizeOf(BitmapCoreHeader) Then InvalidImage;
2256 FWidth:=PBC^.bcWidth;
2257 FHeight:=PBC^.bcHeight;
2258 TIcon(Self).FMaskWidth:=FWidth;
2259 TIcon(Self).FMaskHeight:=FHeight;
2260
2261 //Generate color Bitmap
2262 Size:=FBitmapMemLength;
2263 BitmapOffset:=LongWord(PBC)-LongWord(@pbBuffer^);
2264 BitmapSize:=Size-BitmapOffset;
2265 //let it Point To BitmapCoreHeader
2266 BitmapData:=Pointer(PBC);
2267 OffsBits:=bfh^.bfOffBits-BitmapOffset;
2268 NewImage(BitmapData,BitmapSize,OffsBits,False);
2269
2270 //Generate Mask Bitmap
2271 bfh:=MaskHeader;
2272 PBC:=Pointer(bfh);
2273 If WithFileHeader Then Inc(PBC,SizeOf(BITMAPFILEHEADER));
2274 If PBC^.bcSize<>SizeOf(BitmapCoreHeader) Then InvalidImage;
2275
2276 BitmapOffset:=LongWord(PBC)-LongWord(@pbBuffer^);
2277 BitmapSize:=Size-BitmapOffset;
2278 //let it Point To BitmapCoreHeader
2279 BitmapData:=Pointer(PBC);
2280 OffsBits:=bfh^.bfOffBits-BitmapOffset;
2281 NewImage(BitmapData,BitmapSize,OffsBits,True);
2282 End
2283 Else //Win Icon
2284 Begin
2285 iDir:=pbBuffer;
2286
2287 If iDir^.idReserved<>0 Then
2288 Begin
2289 pbi:=pbBuffer;
2290 If pbi^.biSize<>sizeof(BITMAPINFOHEADER) Then
2291 Begin
2292 PBC:=pbBuffer;
2293 If PBC^.bcSize<>sizeof(BITMAPCOREHEADER) Then InvalidImage;
2294
2295 {
2296 FWidth:=PBC^.bcWidth;
2297 FHeight:=PBC^.bcHeight;
2298
2299 TIcon(Self).FMaskWidth:=FWidth;
2300 TIcon(Self).FMaskHeight:=FHeight;
2301
2302 BitmapSize:=FBitmapMemLength;
2303 OffsBits:=0;
2304 BitmapData:=pbBuffer;
2305 NewImage(BitmapData,BitmapSize,OffsBits,False);
2306 }
2307 WithFileHeader:=False;
2308 goto ProcessIcon;
2309 End
2310 Else
2311 Begin
2312 FWidth:=pbi^.biWidth;
2313 FHeight:=pbi^.biHeight;
2314 TIcon(Self).FMaskWidth:=FWidth;
2315 TIcon(Self).FMaskHeight:=FHeight;
2316
2317 BitmapSize:=FBitmapMemLength;
2318 OffsBits:=0;
2319 BitmapData:=pbBuffer;
2320 NewImage(BitmapData,BitmapSize,OffsBits,False);
2321 End;
2322 End
2323 Else
2324 Begin
2325 If ((iDir^.idType<>1)And(iDir^.idType<>2)) Then InvalidImage;
2326 If iDir^.idCount<>1 Then InvalidImage;
2327
2328 FWidth:=iDir^.idEntries.bWidth;
2329 FHeight:=iDir^.idEntries.bHeight;
2330 TIcon(Self).FMaskWidth:=FWidth;
2331 TIcon(Self).FMaskHeight:=FHeight;
2332
2333 BitmapSize:=iDir^.idEntries.dwBytesInRes;
2334 OffsBits:=0;
2335 BitmapData:=pbBuffer;
2336 //let it Point To BITMAPINFOHEADER
2337 Inc(BitmapData,SizeOf(TICONDIR){iDir^.idEntries.dwImageOffset});
2338 NewImage(BitmapData,BitmapSize,OffsBits,False);
2339 End;
2340 End;
2341 End;
2342
2343 If not (Self Is TIcon) Then CreateHandle;
2344 {$ENDIF}
2345End;
2346
2347Procedure TBitmap.LoadFromResourceId(Id:LongWord);
2348Var pbBuffer:Pointer;
2349 Size:LongWord;
2350 {$IFDEF Win95}
2351 C:cstring;
2352 ResHandle:LongWord;
2353 {$ENDIF}
2354Begin
2355 FIsInvalid:=False; //reset flag !
2356
2357 {$IFDEF OS2}
2358 If ((Self Is TPointer)Or(Self Is TIcon)) Then
2359 Begin
2360 If DosQueryResourceSize(DllModule,RT_POINTER,Id,Size)<>0 Then InvalidImage;
2361 If DosGetResource(DllModule,RT_POINTER,Id,pbBuffer)<>0 Then InvalidImage;
2362 End
2363 Else
2364 Begin
2365 If DosQueryResourceSize(DllModule,RT_BITMAP,Id,Size)<>0 Then InvalidImage;
2366 If DosGetResource(DllModule,RT_BITMAP,Id,pbBuffer)<>0 Then InvalidImage;
2367 End;
2368 If pbBuffer=Nil Then InvalidImage;
2369
2370 ReleaseBitmap;
2371 FBitmapMemLength:=Size;
2372 GetMem(FBitmapMem,FBitmapMemLength);
2373 Move(pbBuffer^,FBitmapMem^,FBitmapMemLength);
2374 If DosFreeResource(pbBuffer)<>0 Then InvalidImage;
2375 {$ENDIF}
2376 {$IFDEF Win95}
2377 C:='#'+tostr(Id);
2378 If Self Is TPointer Then ResHandle:=FindResource(DllModule,C,MAKEINTRESOURCE(RT_CURSOR)^)
2379 Else If Self Is TIcon Then ResHandle:=FindResource(DllModule,C,MAKEINTRESOURCE(RT_GROUP_ICON)^)
2380 Else ResHandle:=FindResource(DllModule,C,MAKEINTRESOURCE(RT_BITMAP)^);
2381 If ResHandle=0 Then InvalidImage;
2382 pbBuffer:=Pointer(LoadResource(DllModule,ResHandle));
2383 If pbBuffer=Nil Then InvalidImage;
2384 Size:=SizeOfResource(DllModule,ResHandle);
2385
2386 ReleaseBitmap;
2387 FBitmapMemLength:=Size;
2388 GetMem(FBitmapMem,FBitmapMemLength);
2389 Move(pbBuffer^,FBitmapMem^,FBitmapMemLength);
2390 {$ENDIF}
2391
2392 SetupBitmap;
2393 changed;
2394 {$IFDEF WIN32}
2395 DestroyHandle;
2396 {$ENDIF}
2397End;
2398
2399Procedure TBitmap.LoadFromResourceName(Const Name:String);
2400Var P:Pointer;
2401 len:LongWord;
2402Begin
2403 FIsInvalid:=False; //reset flag !
2404
2405 P:=FindBitmapRes(Name,len);
2406 If ((P=Nil)Or(len=0)) Then InvalidImage;
2407
2408 ReleaseBitmap;
2409 FBitmapMemLength:=len;
2410 GetMem(FBitmapMem,FBitmapMemLength);
2411 Move(P^,FBitmapMem^,FBitmapMemLength);
2412 SetupBitmap;
2413 changed;
2414 {$IFDEF WIN32}
2415 DestroyHandle;
2416 {$ENDIF}
2417End;
2418
2419Procedure TBitmap.LoadFromMem (Var Buf;Size:LongInt);
2420Begin
2421 FIsInvalid:=False; //reset flag !
2422
2423 ReleaseBitmap;
2424 FBitmapMemLength:=Size;
2425 GetMem(FBitmapMem,FBitmapMemLength);
2426 Move(Buf,FBitmapMem^,FBitmapMemLength);
2427 SetupBitmap;
2428 changed;
2429 {$IFDEF WIN32}
2430 DestroyHandle;
2431 {$ENDIF}
2432End;
2433
2434Procedure TBitmap.ReadStream(Stream:TStream;Size:LongInt);
2435{$IFDEF Win95}
2436Var PBmf:^BITMAPFILEHEADER;
2437 P,p1:Pointer;
2438{$ENDIF}
2439Begin
2440 FIsInvalid:=False; //reset flag !
2441
2442 If Size>0 Then
2443 Begin
2444 ReleaseBitmap;
2445 FBitmapMemLength:=Size;
2446 GetMem(FBitmapMem,FBitmapMemLength);
2447 Stream.ReadBuffer(FBitmapMem^,Size);
2448 {$IFDEF Win95}
2449 PBmf:=Pointer(FBitmapMem);
2450 If PBmf^.bfType=$4D42 Then //Delete File Header
2451 Begin
2452 GetMem(P,Size-SizeOf(BITMAPFILEHEADER));
2453 p1:=FBitmapMem;
2454 Inc(p1,SizeOf(BITMAPFILEHEADER));
2455 Move(p1^,P^,Size-SizeOf(BITMAPFILEHEADER));
2456 FreeMem(FBitmapMem,Size);
2457 Dec(FBitmapMemLength,SizeOf(BITMAPFILEHEADER));
2458 FBitmapMem:=P;
2459 End;
2460 {$ENDIF}
2461 SetupBitmap;
2462 changed;
2463 {$IFDEF WIN32}
2464 DestroyHandle;
2465 {$ENDIF}
2466 End {Size > 0}
2467 Else
2468 Begin
2469 {Setup Bitmap Info structure pbmp2BitmapFile}
2470 InvalidImage;
2471 End;
2472End;
2473
2474Procedure TBitmap.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
2475Begin
2476 FIsInvalid:=False; //reset flag !
2477
2478 If ResName = rnBitmap Then
2479 Begin
2480 If DataLen>0 Then
2481 Begin
2482 If FBitmapMem=Nil Then
2483 Begin
2484 FBitmapMemLength:=DataLen;
2485 GetMem(FBitmapMem,FBitmapMemLength);
2486 Move(Data,FBitmapMem^,FBitmapMemLength);
2487 SetupBitmap;
2488 changed;
2489 {$IFDEF WIN32}
2490 DestroyHandle;
2491 {$ENDIF}
2492 End;
2493 End;
2494 End
2495 Else Inherited ReadSCUResource(ResName,Data,DataLen);
2496End;
2497
2498Function TBitmap.WriteSCUResourceName(Stream:TResourceStream;
2499 ResName:TResourceName):Boolean;
2500Begin
2501 If (FBitmapMemLength>0) And (FBitmapMem<>Nil) Then
2502 Begin
2503 Result:=Stream.NewResourceEntry(ResName,FBitmapMem^,FBitmapMemLength);
2504 End
2505 Else Result:=True;
2506End;
2507
2508Function TBitmap.WriteSCUResource(Stream:TResourceStream):Boolean;
2509Begin
2510 Result := WriteSCUResourceName(Stream,rnBitmap);
2511End;
2512
2513Procedure TBitmap.LoadFromStream(Stream:TStream);
2514Begin
2515 FIsInvalid:=False; //reset flag !
2516 ReadStream(Stream,Stream.Size-Stream.Position);
2517 changed;
2518End;
2519
2520// Retrieves data from OS bitmap into memory,
2521// laid out as in a BMP file. For OS/2:
2522// Fileheader
2523// InfoHeader
2524// Palette (if 256 colors or less)
2525// Bits
2526Procedure TBitmap.Update;
2527{$IFDEF OS2}
2528Var
2529 PaletteSize: longint;
2530 BitsSize: longint;
2531 InfoHeader: BITMAPINFOHEADER;
2532 pInfoHeader: PBITMAPINFOHEADER;
2533 pFileHeader: ^BITMAPFILEHEADER;
2534 pBitmapBits: pbyte;
2535{$ENDIF}
2536{$IFDEF Win95}
2537Var
2538 BI:BitmapCoreInfo;
2539 pbi:^BitmapCoreInfo;
2540 P,pp:Pointer;
2541 cbInfo,cbBuffer:LongWord;
2542
2543 BI2:BitmapInfo;
2544{$ENDIF}
2545Begin
2546 {$IFDEF OS2}
2547 //fr PM 2.X format Bitmap*2 statt Bitmap* und RGB2 statt RGB
2548
2549 // Get bitmap information header
2550 InfoHeader.cbFix:=SizeOf(BITMAPINFOHEADER);
2551 If Not GpiQueryBitmapInfoHeader(FBitmapHandle,InfoHeader) Then Exit;
2552
2553 // If paletted image (256 colours, 8 bpp, or less) then
2554 // calculate palette size
2555 if InfoHeader.cBitCount <= 8 then
2556 PaletteSize := SizeOf(RGB)*(1 Shl InfoHeader.cBitCount)
2557 else
2558 // not a paletted image, no palette
2559 PaletteSize := 0;
2560
2561 // Calculate size of bitmap bits
2562 // Round row size up to nearest 32bit boundary
2563 BitsSize:= (((InfoHeader.cBitCount*InfoHeader.CX)+31) Div 32)*4
2564 * InfoHeader.CY
2565 * InfoHeader.cPlanes;
2566
2567 // Free up previous memory, if any
2568 If FBitmapMem<>Nil Then FreeMem(FBitmapMem,FBitmapMemLength);
2569
2570 // calculate total bitmap memory required and allocate
2571 FBitmapMemLength:= sizeof(BITMAPFILEHEADER)
2572 + PaletteSize
2573 + BitsSize;
2574 GetMem(FBitmapMem,FBitmapMemLength);
2575
2576 // create pointers into memory for the info header and the bits
2577 pInfoHeader := PBITMAPINFOHEADER( FBitmapMem
2578 + SizeOf(BITMAPFILEHEADER)
2579 - SizeOf(BITMAPINFOHEADER) );
2580 pBitmapBits := FBitmapMem
2581 + SizeOf(BITMAPFILEHEADER)
2582 + PaletteSize;
2583
2584 // Copt info header
2585 pInfoHeader^ := InfoHeader;
2586
2587 // Query all bitmap bits & info+palette
2588 GpiQueryBitmapBits( FBitmapPS,
2589 0, // start scanline
2590 InfoHeader.CY, // scanline count (all)
2591 pBitmapBits^, // bits
2592 pInfoHeader^); // info header and palette
2593
2594 // setup bitmap file header
2595 pFileHeader := FBitmapMem;
2596 pFileHeader^.usType:=BFT_BMAP;
2597 pFileHeader^.cbSize:=SizeOf(BITMAPFILEHEADER);
2598 pFileHeader^.XHotSpot:=FXHotSpot;
2599 pFileHeader^.YHotSpot:=FYHotSpot;
2600 pFileHeader^.offBits:=SizeOf(BITMAPFILEHEADER)+PaletteSize;
2601
2602 {$ENDIF}
2603 {$IFDEF Win95}
2604 CreateHandle;
2605 SelectObject(FBitmapPS,FOldBitmap);
2606
2607 FillChar(BI,SizeOf(BI),0);
2608
2609 FillChar(BI2,SizeOf(BI2),0);
2610 BI2.bmiHeader.biSize:=SizeOf(BITMAPINFOHEADER);
2611 GetDIBits(FBitmapPS,FBitmapHandle,0,0,Nil,BI2,0);
2612 If FOrigBitCount>0 Then BI2.bmiHeader.biBitCount:=FOrigBitCount;
2613 If FOrigPlanes>0 Then BI2.bmiHeader.biPlanes:=FOrigPlanes;
2614
2615 cbInfo:=SizeOf(BitmapCoreHeader)+SizeOf(RGBTriple)*(1 Shl BI2.bmiHeader.biBitCount);
2616 LastcbInfo:=cbInfo;
2617 GetMem(pbi,cbInfo);
2618 With pbi^.bmciHeader Do
2619 Begin
2620 bcSize:=SizeOf(BitmapCoreHeader);
2621 bcWidth:=BI2.bmiHeader.biWidth;
2622 bcHeight:=BI2.bmiHeader.biHeight;
2623 bcPlanes:=BI2.bmiHeader.biPlanes;
2624 bcBitCount:=BI2.bmiHeader.biBitCount;
2625 End;
2626 cbBuffer:=(((BI2.bmiHeader.biBitCount*BI2.bmiHeader.biWidth)+31) Div 32)
2627 *4*BI2.bmiHeader.biHeight*BI2.bmiHeader.biPlanes;
2628 GetMem(P,cbBuffer);
2629 GetDIBits(FBitmapPS,FBitmapHandle,0,BI2.bmiHeader.biHeight,P^,pbi^,DIB_RGB_COLORS);
2630
2631 If FBitmapMem<>Nil Then FreeMem(FBitmapMem,FBitmapMemLength);
2632 FBitmapMemLength:=cbInfo+cbBuffer;
2633 GetMem(FBitmapMem,FBitmapMemLength);
2634 pp:=FBitmapMem;
2635 Move(pbi^,pp^,cbInfo);
2636 Inc(pp,cbInfo);
2637 Move(P^,pp^,cbBuffer);
2638
2639 FreeMem(pbi,cbInfo);
2640 FreeMem(P,cbBuffer);
2641 SelectObject(FBitmapPS,FBitmapHandle);
2642 DestroyHandle;
2643 {$ENDIF}
2644End;
2645
2646Procedure TBitmap.SaveToStream(Stream:TStream);
2647{$IFDEF Win95}
2648Var FH:BITMAPFILEHEADER;
2649Const BFT_BMAP =$4D42; { 'BM' }
2650{$ENDIF}
2651Begin
2652 {$IFDEF WIN32}
2653 CreateHandle;
2654 {$ENDIF}
2655
2656 Update;
2657
2658 If ((FBitmapHandle=0)Or(FBitmapMem=Nil)Or(FBitmapMemLength=0)) Then
2659 Begin
2660 {$IFDEF WIN32}
2661 DestroyHandle;
2662 {$ENDIF}
2663 Exit;
2664 End;
2665 {warum?, die Aktion wandelt mein Windows Bitmap (15478 Byte)
2666 aus einer Datenbank in etwas anderes (15194 Byte) um, daá auch noch
2667 falsche Farben beim Wiedereinlesen aus der DB anzeigt}
2668
2669 If FBitmapMem<>Nil Then
2670 If FBitmapMemLength>0 Then
2671 Begin
2672 {$IFDEF Win95}
2673 If Not (Self Is TIcon) Then
2674 Begin
2675 Update;
2676 FH.bfType:=BFT_BMAP;
2677 FH.bfSize:=SizeOf(BITMAPFILEHEADER)+SizeOf(BitmapCoreHeader);
2678 FH.bfReserved1:=0;
2679 FH.bfReserved2:=0;
2680 FH.bfOffBits:=SizeOf(BITMAPFILEHEADER)+LastcbInfo;
2681 Stream.WriteBuffer(FH,SizeOf(BITMAPFILEHEADER));
2682 End
2683 Else Update;
2684 {$ENDIF}
2685 Stream.WriteBuffer(FBitmapMem^,FBitmapMemLength);
2686 End;
2687
2688 {$IFDEF WIN32}
2689 DestroyHandle;
2690 {$ENDIF}
2691End;
2692
2693{$IFDEF OS2}
2694Procedure TBitmap.CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);
2695Var
2696 BitCount: LongWord;
2697 DeviceContextData:DEVOPENSTRUC;
2698 DriverName:cstring;
2699 PresentationPageSize: SIZEL;
2700 BitmapInformationHeader: BITMAPINFOHEADER;
2701
2702 PaletteColors: array[ 0..255 ] of longword;
2703
2704 OldBitmap: HBITMAP;
2705 Palette: HPALETTE;
2706 OldPalette: HPALETTE;
2707 pDefaultColors: PLONG;
2708 rc: ERRORID;
2709Begin
2710 FIsInvalid:= False; //reset flag !
2711
2712 ReleaseBitmap;
2713
2714 If Colors <= 2 Then
2715 BitCount := 1
2716 Else If Colors <= 16 Then
2717 BitCount := 4
2718 Else If Colors <= 256 Then
2719 BitCount := 8
2720 Else If Colors <= 65536 Then
2721 BitCount := 16
2722 Else
2723 BitCount := 32;
2724
2725 FWidth := NewWidth;
2726 FHeight := NewHeight;
2727 FOrigBitCount := BitCount;
2728 FOrigPlanes := 1;
2729 FColorCount := Colors;
2730
2731 // Create a memory device context
2732 FillChar( DeviceContextData,
2733 SizeOf( DeviceContextData ),
2734 0 );
2735
2736 DriverName:='DISPLAY'; // set to display driver
2737 DeviceContextData.pszDriverName:= @DriverName;
2738
2739 FBitmapDC := DevOpenDC( AppHandle, // app anchor block
2740 OD_MEMORY, // DC type = memory
2741 '*', // no device information
2742 2, // number of items in dop
2743 DeviceContextData, // device open structure
2744 0 ); // compatibility with screen
2745 If FBitmapDC = 0 Then
2746 InvalidImage; // failed to create DC
2747
2748 // Create a presentation space
2749 PresentationPageSize.CX := 1;
2750 PresentationPageSize.CY := 1; // huh?
2751
2752 FBitmapPS := GpiCreatePS( AppHandle, // app anchor block
2753 FBitmapDC, // device context
2754 PresentationPageSize, // size
2755 PU_PELS // use pixels
2756 Or GPIA_ASSOC // associate with DC
2757 Or GPIT_MICRO ); // micro PS
2758 If FBitmapPS = GPI_ERROR Then
2759 InvalidImage;
2760
2761 // Create the bitmap
2762
2763 FillChar( BitmapInformationHeader,
2764 sizeof( BitmapInformationHeader ),
2765 0 );
2766 BitmapInformationHeader.cbFix := sizeof( BitmapInformationHeader );
2767 BitmapInformationHeader.cx := Width;
2768 BitmapInformationHeader.cy := Height;
2769 BitmapInformationHeader.cPlanes := 1;
2770 BitmapInformationHeader.cBitCount := BitCount;
2771 FBitmapHandle:= GpiCreateBitmap( FBitmapPS,
2772 BitmapInformationHeader,
2773 0, // don't initialise
2774 nil,
2775 nil );
2776
2777 // set the bitmap into the presentation space so we can draw on it
2778 OldBitmap := GpiSetBitmap( FBitmapPS,
2779 FBitmapHandle );
2780 if OldBitmap = HBM_ERROR then
2781 InvalidImage;
2782
2783 if BitCount < 16 then
2784 begin
2785 // create and initialise the palette
2786
2787 // blank out palette
2788 FillChar( PaletteColors, sizeof( PaletteColors ), 0 );
2789
2790 // retrieve default colors (first 16)
2791 pDefaultColors := PLONG( @PaletteColors );
2792 GpiQueryLogColorTable( FBitmapPS,
2793 0, // flags
2794 0, // first color
2795 15, // last color
2796 pDefaultColors^ );
2797
2798 // Create a palette
2799 Palette := GpiCreatePalette( AppHandle, // application anchor block
2800 0, // options - none
2801 LCOLF_CONSECRGB, // format (standard)
2802 ColorCount,
2803 PaletteColors );
2804 if Palette = GPI_ERROR Then
2805 begin
2806 rc := WinGetLastError( AppHandle );
2807 InvalidImage;
2808 end;
2809
2810 OldPalette := GpiSelectPalette( FBitmapPS,
2811 Palette );
2812 if OldPalette = PAL_ERROR Then
2813 InvalidImage;
2814 end
2815 else
2816 begin
2817 // set into non-palettised mode (I think?)
2818 GpiCreateLogColorTable(FBitmapPS,LCOL_RESET,LCOLF_RGB,0,0,NIL);
2819 end;
2820
2821 FEmpty:=False;
2822End;
2823{$ENDIF}
2824
2825Function TBitmap.IsEqual(Bitmap:TBitmap):Boolean;
2826Begin
2827 Result := False;
2828 If Bitmap <> Nil Then
2829 If Bitmap.FBitmapMemLength = FBitmapMemLength Then
2830 Begin
2831 If FBitmapMemLength = 0 Then Result := True
2832 Else If CompareMem(Bitmap.FBitmapMem^,FBitmapMem^,FBitmapMemLength)
2833 Then Result := True;
2834 End;
2835End;
2836
2837{
2838ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2839º º
2840º Speed-Pascal/2 Version 2.0 º
2841º º
2842º Speed-Pascal Component Classes (SPCC) º
2843º º
2844º This section: TIcon Class Implementation º
2845º º
2846º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2847º º
2848ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2849}
2850
2851Procedure TIcon.SetupComponent;
2852Begin
2853 Inherited SetupComponent;
2854
2855 Name:='Icon';
2856End;
2857
2858Function TIcon.GetMaskCanvas:TCanvas;
2859Begin
2860 If FBitmapPS=0 Then CreateHandle;
2861
2862 If FMaskCanvas = Nil Then
2863 Begin
2864 FMaskCanvas.Create(Self);
2865 FMaskCanvas.FBitmap:=Self;
2866 Include(FMaskCanvas.ComponentState, csDetail);
2867 FMaskCanvas.Handle := FMaskPS;
2868 FMaskCanvas.Init;
2869 End
2870 Else
2871 Begin
2872 If FMaskCanvas.Handle<>FMaskPS Then
2873 Begin
2874 FMaskCanvas.Handle:=FMaskPS;
2875 FMaskCanvas.Init;
2876 End;
2877 End;
2878 Result := FMaskCanvas;
2879End;
2880
2881
2882Procedure TIcon.CreateHandle;
2883Begin
2884 Inherited CreateHandle;
2885 If FIsInvalid Then exit; //don't create handle for invalid objects (loop) !
2886
2887 {$IFDEF WIN32}
2888 If FMaskHandle=0 Then InvalidImage;
2889 If FMaskPS=0 Then
2890 Begin
2891 FMaskPS:=CreateCompatibleDC(0);
2892 FOldMaskBitmap:=SelectObject(FMaskPS,FMaskHandle);
2893 End;
2894
2895 If FMaskCanvas = Nil Then
2896 Begin
2897 FMaskCanvas.Create(Self);
2898 FMaskCanvas.FBitmap:=Self;
2899 Include(FMaskCanvas.ComponentState, csDetail);
2900 End;
2901
2902 If FMaskCanvas.Handle<>FMaskPS Then
2903 Begin
2904 MaskCanvas.Handle:=FMaskPS;
2905 MaskCanvas.Init;
2906 End;
2907 {$ENDIF}
2908End;
2909
2910
2911Procedure TIcon.DestroyHandle;
2912Begin
2913 Inherited DestroyHandle;
2914
2915 If PermanentHandle Then exit;
2916
2917 {$IFDEF WIN32}
2918 If FMaskPal<>0 Then
2919 If FMaskPS<>0 Then SelectObject(FMaskPS,FOldMaskPalette);
2920 FOldMaskPalette:=0;
2921 If FMaskPS<>0 Then
2922 Begin
2923 SelectObject(FMaskPS,FOldMaskBitmap);
2924 If not DeleteDC(FMaskPS) Then InvalidImage;
2925 End;
2926 FMaskPS:=0;
2927 If FMaskCanvas<>Nil Then FMaskCanvas.Handle:=0;
2928 FOldMaskBitmap:=0;
2929 If FMaskHandle<>0 Then If not DeleteObject(FMaskHandle) Then InvalidImage;
2930 FMaskHandle:=0;
2931 //FIconPointerHandle remains !
2932 {$ENDIF}
2933End;
2934
2935
2936Procedure TIcon.InvalidImage;
2937Begin
2938 FIsInvalid:=True;
2939 ReleaseBitmap;
2940 Raise EInvalidIcon.Create(LoadNLSStr(SInvalidIcon));
2941End;
2942
2943Function TIcon.GetHandle:LongWord;
2944Begin
2945 Result:=FIconPointerHandle;
2946End;
2947
2948Procedure TIcon.SetupBitmap;
2949Begin
2950 Inherited SetupBitmap;
2951
2952 CreateIconPointerHandle;
2953
2954 If FMaskCanvas=Nil Then FMaskCanvas.Create(Self);
2955 FMaskCanvas.Handle:=FMaskPS;
2956 FMaskCanvas.Init;
2957 CreateHandle;
2958End;
2959
2960Procedure TIcon.Draw(Canvas:TCanvas;Const Dest:TRect);
2961{$IFDEF OS2}
2962Var ptls,maskptls:Array[0..3] Of TPoint;
2963{$ENDIF}
2964{$IFDEF Win95}
2965Var _Dest:TRect;
2966 OldPal:LongWord;
2967{$ENDIF}
2968Begin
2969 {$IFDEF OS2}
2970 //temporary invert Mask
2971 maskptls[0].X:=0;
2972 maskptls[0].Y:=FHeight;
2973 maskptls[1].X:=FWidth;
2974 maskptls[1].Y:=FHeight*2;
2975 maskptls[2].X:=0;
2976 maskptls[2].Y:=FHeight;
2977 maskptls[3].X:=FWidth;
2978 maskptls[3].Y:=FHeight*2;
2979 GpiBitBlt(FMaskPS,FMaskPS,4,maskptls[0],ROP_NOTSRCCOPY,BBO_IGNORE);
2980
2981 //Copy Mask Bitmap With logical And (TRANSPARENT areas are now White In the Mask, others Black)
2982 ptls[0].X:=Dest.Left;
2983 ptls[0].Y:=Dest.Bottom;
2984 ptls[1].X:=Dest.Right;
2985 ptls[1].Y:=Dest.Top;
2986 ptls[2].X:=0;
2987 ptls[2].Y:=FHeight;
2988 ptls[3].X:=FWidth;
2989 ptls[3].Y:=FHeight*2;
2990 GpiBitBlt(Canvas.Handle,FMaskPS,4,ptls[0],ROP_SRCAND,BBO_IGNORE);
2991
2992 GpiBitBlt(FMaskPS,FMaskPS,4,maskptls[0],ROP_NOTSRCCOPY,BBO_IGNORE);
2993
2994 //Copy color Bitmap With logical Or
2995 ptls[0].X:=Dest.Left;
2996 ptls[0].Y:=Dest.Bottom;
2997 ptls[1].X:=Dest.Right;
2998 ptls[1].Y:=Dest.Top;
2999 ptls[2].X:=0;
3000 ptls[2].Y:=0;
3001 ptls[3].X:=FWidth;
3002 ptls[3].Y:=FHeight;
3003 GpiBitBlt(Canvas.Handle,FBitmapPS,4,ptls[0],ROP_SRCPAINT,BBO_IGNORE);
3004 {$ENDIF}
3005 {$IFDEF Win95}
3006 CreateHandle;
3007
3008 OldPal:=SelectPalette(Canvas.Handle,FBitmapPal,True);
3009
3010 _Dest := Dest;
3011 RectToWin32Rect(_Dest);
3012 TransformRectToWin32(_Dest,Canvas.Control,Canvas.Graphic);
3013
3014 //Copy Mask Bitmap With logical And (TRANSPARENT areas are Black In the Mask, others White)
3015 If (_Dest.Right-_Dest.Left=FWidth) And (_Dest.Top-_Dest.Bottom=FHeight) Then
3016 Begin
3017 WinGDI.BitBlt(Canvas.Handle,_Dest.Left,_Dest.Bottom,
3018 FWidth,FHeight,FMaskPS,0,0,SRCAND);
3019 End
3020 Else
3021 Begin
3022 StretchBlt(Canvas.Handle,_Dest.Left,_Dest.Bottom,
3023 _Dest.Right-_Dest.Left,_Dest.Top-_Dest.Bottom,
3024 FMaskPS, 0, 0, FWidth, FHeight,SRCAND);
3025 End;
3026
3027 //Copy color Bitmap With logical Xor
3028 If (_Dest.Right-_Dest.Left=FWidth) And (_Dest.Top-_Dest.Bottom=FHeight) Then
3029 Begin
3030 WinGDI.BitBlt(Canvas.Handle,_Dest.Left,_Dest.Bottom,
3031 FWidth,FHeight,FBitmapPS,0,0,SRCINVERT);
3032 End
3033 Else
3034 Begin
3035 StretchBlt(Canvas.Handle,_Dest.Left,_Dest.Bottom,
3036 _Dest.Right-_Dest.Left,_Dest.Top-_Dest.Bottom,
3037 FBitmapPS, 0, 0, FWidth, FHeight,SRCINVERT);
3038 End;
3039
3040 If OldPal<>FBitmapPal Then SelectPalette(Canvas.Handle,OldPal,True);
3041
3042 DestroyHandle;
3043 {$ENDIF}
3044End;
3045
3046Procedure TIcon.ReleaseBitmap;
3047Begin
3048 If FMaskCanvas<>Nil Then
3049 Begin
3050 FMaskCanvas.Destroy;
3051 FMaskCanvas:=nil;
3052 End;
3053
3054 {$IFDEF OS2}
3055 GpiSetBitmap(FMaskPS,0);// unselect mask bitmap
3056 If FMaskPal<>0 Then GpiDeletePalette(FMaskPal);
3057 If FMaskHandle<>0 Then GpiDeleteBitmap(FMaskHandle);
3058 If FMaskPS<>0 Then GpiDestroyPS(FMaskPS);
3059 If FMaskDC<>0 Then DevCloseDC(FMaskDC);
3060 If FIconPointerHandle<>0 Then WinDestroyPointer(FIconPointerHandle);
3061 {$ENDIF}
3062 {$IFDEF Win95}
3063 If FMaskPS<>0 Then
3064 Begin
3065 If FMaskHandle<>0 Then SelectObject(FMaskPS,FOldMaskBitmap);
3066 If FMaskPal<>0 Then SelectObject(FMaskPS,FOldMaskPalette);
3067 End;
3068 If FMaskPS<>0 Then If not DeleteDC(FMaskPS) Then InvalidImage;
3069 If FMaskPal<>0 Then If not DeleteObject(FMaskPal) Then InvalidImage;
3070 If FMaskHandle<>0 Then If not DeleteObject(FMaskHandle) Then InvalidImage;
3071 If FIconPointerHandle<>0 Then If not DestroyIcon(FIconPointerHandle) Then InvalidImage;
3072 {$ENDIF}
3073 FMaskPS:=0;
3074 FMaskPal:=0;
3075 FMaskHandle:=0;
3076 FMaskDC:=0;
3077 FIconPointerHandle:=0;
3078
3079 Inherited ReleaseBitmap;
3080End;
3081
3082Procedure TIcon.CreateIconPointerHandle;
3083{$IFDEF OS2}
3084Var I:POINTERINFO;
3085{$ENDIF}
3086{$IFDEF Win95}
3087Var I:ICONINFO;
3088 ADC,MemDC:HDC;
3089 H,OldBmp:LongWord;
3090{$ENDIF}
3091Begin
3092 {$IFDEF OS2}
3093 GpiSetBitmap(FBitmapPS,0);
3094 GpiSetBitmap(FMaskPS,0);
3095
3096 If Self Is TPointer Then I.fPointer:=1
3097 Else I.fPointer:=0;
3098 I.XHotSpot:=FXHotSpot;
3099 I.YHotSpot:=FYHotSpot;
3100 I.hbmPointer:=FMaskHandle;
3101 I.hbmColor:=FBitmapHandle;
3102 I.hbmMiniPointer:=0;
3103 I.hbmMiniColor:=0;
3104 FIconPointerHandle:=WinCreatePointerIndirect(HWND_DESKTOP,I);
3105
3106 GpiSetBitmap(FBitmapPS,FBitmapHandle);
3107 GpiSetBitmap(FMaskPS,FMaskHandle);
3108 {$ENDIF}
3109 {$IFDEF Win95}
3110 If FIconPointerHandle=0 Then
3111 Begin
3112 If Self Is TPointer Then I.FIcon:=False
3113 Else I.FIcon:=True;
3114
3115 ADC:=GetDC(0);
3116 MemDC:=CreateCompatibleDC(ADC);
3117
3118 //supply both And and Xor Mask For pointers
3119 If I.FIcon Then H:=CreateBitmap(FWidth,FHeight,1,1,Nil)
3120 Else H:=CreateBitmap(FWidth,FHeight*2,1,1,Nil);
3121 OldBmp:=SelectObject(MemDC,H);
3122 If not I.FIcon Then
3123 Begin
3124 WinGDI.BitBlt(MemDC,0,0,FWidth,FHeight*2,MemDC,0,0,WHITENESS);
3125 WinGDI.BitBlt(MemDC,0,0,FWidth,FHeight,FMaskPS,0,0,SRCCOPY);
3126 End
3127 Else WinGDI.BitBlt(MemDC,0,0,FWidth,FHeight,FMaskPS,0,0,SRCCOPY);
3128
3129 I.XHotSpot:=FXHotSpot;
3130 I.YHotSpot:=FYHotSpot;
3131 I.hbmMask:=H;
3132 I.hbmColor:=FBitmapHandle;
3133 FIconPointerHandle:=CreateIconIndirect(I);
3134
3135 SelectObject(MemDC,OldBmp);
3136 If MemDC<>0 Then If not DeleteDC(MemDC) Then InvalidImage;
3137 If ReleaseDC(0,ADC)=0 Then InvalidImage;
3138 If not DeleteObject(H) Then InvalidImage;
3139 End;
3140 {$ENDIF}
3141End;
3142
3143Procedure TIcon.Update;
3144{$IFDEF OS2}
3145Var
3146 cbBuffer,cbBufferMask:LongWord;
3147 cbInfo,cbInfoMask:LongWord;
3148 Buf,BufMask:Pointer;
3149 BI,BIMask:PBITMAPINFO;
3150 FH,FHMask:BITMAPFILEHEADER;
3151 BIH,BIHMask:BITMAPINFOHEADER;
3152 P:Pointer;
3153{$ENDIF}
3154{$IFDEF Win95}
3155Var
3156 iDir:TICONDIR;
3157 iEntry:ICONDIRENTRY;
3158 BI,BIMask:BitmapInfo;
3159 pbi,PBIMask:^BitmapInfo;
3160 P,pMask,pp:Pointer;
3161 cbInfo,cbInfoMask,cbBuffer,cbBufferMask:LongWord;
3162{$ENDIF}
3163Begin
3164 If ((FBitmapMem=Nil)Or(FBitmapMemLength=0)Or(FBitmapHandle=0)) Then Exit;
3165
3166 {$IFDEF OS2}
3167 If FIconPointerHandle<>0 Then WinDestroyPointer(FIconPointerHandle);
3168 CreateIconPointerHandle;
3169 {$ENDIF}
3170
3171 {$IFDEF Win95}
3172 CreateHandle;
3173 If FIconPointerHandle<>0 Then DestroyIcon(FIconPointerHandle);
3174 CreateIconPointerHandle;
3175 {$ENDIF}
3176
3177 {$IFDEF OS2}
3178 BIHMask.cbFix:=SizeOf(BITMAPINFOHEADER);
3179 If Not GpiQueryBitmapInfoHeader(FMaskHandle,BIHMask) Then Exit;
3180 cbBufferMask:=(((BIHMask.cBitCount*BIHMask.CX)+31) Div 32)*4*BIHMask.CY*BIHMask.cPlanes;
3181 GetMem(BufMask,cbBufferMask);
3182 cbInfoMask:=SizeOf(BITMAPINFOHEADER)+SizeOf(RGB)*(1 Shl BIHMask.cBitCount);
3183 GetMem(BIMask,cbInfoMask);
3184 Move(BIHMask,BIMask^,SizeOf(BITMAPINFOHEADER));
3185 GpiQueryBitmapBits(FMaskPS,0,BIHMask.CY,BufMask^,BIMask^);
3186
3187 If Self Is TPointer Then FHMask.usType:=BFT_COLORPOINTER
3188 Else FHMask.usType:=BFT_COLORICON;
3189 FHMask.cbSize:=SizeOf(BITMAPFILEHEADER);
3190 FHMask.XHotSpot:=FXHotSpot;
3191 FHMask.YHotSpot:=FYHotSpot;
3192 FHMask.offBits:=(SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER))+cbInfoMask;
3193
3194 BIH.cbFix:=SizeOf(BITMAPINFOHEADER);
3195 If Not GpiQueryBitmapInfoHeader(FBitmapHandle,BIH) Then Exit;
3196 cbBuffer:=(((BIH.cBitCount*BIH.CX)+31) Div 32)*4*BIH.CY*BIH.cPlanes;
3197 GetMem(Buf,cbBuffer);
3198 cbInfo:=SizeOf(BITMAPINFOHEADER)+SizeOf(RGB)*(1 Shl BIH.cBitCount);
3199 GetMem(BI,cbInfo);
3200 Move(BIH,BI^,SizeOf(BITMAPINFOHEADER));
3201 GpiQueryBitmapBits(FBitmapPS,0,BIH.CY,Buf^,BI^);
3202
3203 If Self Is TPointer Then FH.usType:=BFT_COLORPOINTER
3204 Else FH.usType:=BFT_COLORICON;
3205 FH.cbSize:=SizeOf(BITMAPFILEHEADER);
3206 FH.XHotSpot:=FXHotSpot;
3207 FH.YHotSpot:=FYHotSpot;
3208 FH.offBits:=(SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER))+cbInfo;
3209 Inc(FH.offBits,(SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER))+cbInfoMask+cbBufferMask);
3210
3211 Inc(FHMask.offBits,(SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER))+cbInfo);
3212
3213 FreeMem(FBitmapMem,FBitmapMemLength);
3214 FBitmapMemLength:=SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER)+cbInfo+cbBuffer;
3215 Inc(FBitmapMemLength,SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER)+cbInfoMask+cbBufferMask);
3216 GetMem(FBitmapMem,FBitmapMemLength);
3217 P:=FBitmapMem;
3218 Move(FHMask,P^,SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER));
3219 Inc(P,SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER));
3220 Move(BIMask^,P^,cbInfoMask);
3221 Inc(P,cbInfoMask);
3222 Move(FH,P^,SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER));
3223 Inc(P,SizeOf(BITMAPFILEHEADER)-SizeOf(BITMAPINFOHEADER));
3224 Move(BI^,P^,cbInfo);
3225 Inc(P,cbInfo);
3226 Move(BufMask^,P^,cbBufferMask);
3227 Inc(P,cbBufferMask);
3228 Move(Buf^,P^,cbBuffer);
3229
3230 FreeMem(Buf,cbBuffer);
3231 FreeMem(BI,cbInfo);
3232 FreeMem(BufMask,cbBufferMask);
3233 FreeMem(BIMask,cbInfoMask);
3234 {$ENDIF}
3235 {$IFDEF Win95}
3236 CreateHandle;
3237
3238 SelectObject(FBitmapPS,FOldBitmap);
3239 SelectObject(FMaskPS,FOldMaskBitmap);
3240
3241 FillChar(BI,SizeOf(BI),0);
3242 FillChar(BIMask,SizeOf(BIMask),0);
3243
3244 BI.bmiHeader.biSize:=SizeOf(BITMAPINFOHEADER);
3245 GetDIBits(FBitmapPS,FBitmapHandle,0,0,Nil,BI,0);
3246 If FOrigBitCount>0 Then BI.bmiHeader.biBitCount:=FOrigBitCount;
3247 If FOrigPlanes>0 Then BI.bmiHeader.biPlanes:=FOrigPlanes;
3248
3249 BIMask.bmiHeader.biSize:=SizeOf(BITMAPINFOHEADER);
3250 GetDIBits(FMaskPS,FMaskHandle,0,0,Nil,BIMask,0);
3251
3252 iDir.idReserved:=0;
3253 If Self Is TPointer Then iDir.idType:=2
3254 Else iDir.idType:=1;
3255 iDir.idCount:=1;
3256 iDir.idEntries.bWidth:=FWidth;
3257 iDir.idEntries.bHeight:=FHeight;
3258 iDir.idEntries.bColorCount:=BI.bmiHeader.biPlanes * (LongWord(1) Shl BI.bmiHeader.biBitCount);
3259 iDir.idEntries.bReserved:=0;
3260 iDir.idEntries.wPlanes:=0;
3261 iDir.idEntries.wBitCount:=0;
3262 iDir.idEntries.dwBytesInRes:=0{Size Of image};
3263 iDir.idEntries.dwImageOffset:=SizeOf(TICONDIR);
3264
3265 cbInfo:=SizeOf(BITMAPINFOHEADER)+SizeOf(RGBQuad)*(1 Shl BI.bmiHeader.biBitCount);
3266 GetMem(pbi,cbInfo);
3267 pbi^.bmiHeader:=BI.bmiHeader;
3268 cbBuffer:=(((BI.bmiHeader.biBitCount*BI.bmiHeader.biWidth)+31) Div 32)
3269 *4*BI.bmiHeader.biHeight*BI.bmiHeader.biPlanes;
3270 GetMem(P,cbBuffer);
3271 GetDIBits(FBitmapPS,FBitmapHandle,0,BI.bmiHeader.biHeight,P^,pbi^,DIB_RGB_COLORS);
3272
3273 cbInfoMask:=SizeOf(BITMAPINFOHEADER)+SizeOf(RGBQuad)*2;
3274 GetMem(PBIMask,cbInfoMask);
3275 With PBIMask^.bmiHeader Do
3276 Begin
3277 biSize:=SizeOf(BITMAPINFOHEADER);
3278 biWidth:=FWidth;
3279 biHeight:=FHeight;
3280 biPlanes:=1;
3281 biBitCount:=1;
3282 End;
3283 cbBufferMask:=(((1*BI.bmiHeader.biWidth)+31) Div 32)
3284 *4*BI.bmiHeader.biHeight*1;
3285 GetMem(pMask,cbBufferMask);
3286 GetDIBits(FMaskPS,FMaskHandle,0,BI.bmiHeader.biHeight,pMask^,PBIMask^,DIB_RGB_COLORS);
3287
3288 iDir.idEntries.dwBytesInRes:=cbInfo+cbBuffer+cbBufferMask;
3289
3290 FreeMem(FBitmapMem,FBitmapMemLength);
3291 FBitmapMemLength:=SizeOf(TICONDIR)+iDir.idEntries.dwBytesInRes;
3292 GetMem(FBitmapMem,FBitmapMemLength);
3293 pp:=FBitmapMem;
3294 Move(iDir,pp^,SizeOf(TICONDIR));
3295 Inc(pp,SizeOf(TICONDIR));
3296 pbi^.bmiHeader.biHeight:=FHeight*2;
3297 pbi^.bmiHeader.biSizeImage:=cbBuffer+cbBufferMask;
3298 Move(pbi^,pp^,cbInfo);
3299 Inc(pp,cbInfo);
3300 Move(P^,pp^,cbBuffer);
3301 Inc(pp,cbBuffer);
3302 Move(pMask^,pp^,cbBufferMask);
3303
3304 FreeMem(pbi,cbInfo);
3305 FreeMem(PBIMask,cbInfoMask);
3306 FreeMem(P,cbBuffer);
3307 FreeMem(pMask,cbBufferMask);
3308 SelectObject(FBitmapPS,FBitmapHandle);
3309 SelectObject(FMaskPS,FMaskHandle);
3310
3311 DestroyHandle;
3312 {$ENDIF}
3313End;
3314
3315
3316Procedure TIcon.LoadFromResourceName(Const Name:String);
3317Var P:Pointer;
3318 len:LongWord;
3319Begin
3320 FIsInvalid:=False; //reset flag !
3321
3322 P:=FindIconRes(Name,len);
3323 If ((P=Nil)Or(len=0)) Then InvalidImage;
3324
3325 ReleaseBitmap;
3326 FBitmapMemLength:=len;
3327 GetMem(FBitmapMem,FBitmapMemLength);
3328 Move(P^,FBitmapMem^,FBitmapMemLength);
3329 SetupBitmap;
3330 changed;
3331 {$IFDEF WIN32}
3332 DestroyHandle;
3333 {$ENDIF}
3334End;
3335
3336Procedure TIcon.CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);
3337{$IFDEF OS2}
3338Var dop:DEVOPENSTRUC;
3339 pc:cstring;
3340 sizl:SIZEL;
3341 BIH:BITMAPINFOHEADER;
3342 ps,DC:LongWord;
3343 ptls:Array[0..3] Of TPoint;
3344{$ENDIF}
3345Begin
3346 FIsInvalid:=False; //reset flag !
3347
3348 If ((Colors<>2)And(Colors<>16)) Then Colors:=16;
3349 If ((NewWidth<>16)And(NewWidth<>32)And(NewWidth<>64)) Then NewWidth:=32;
3350 If ((NewHeight<>16)And(NewHeight<>32)And(NewHeight<>64)) Then NewHeight:=32;
3351 Inherited CreateNew(NewWidth,NewHeight,Colors);
3352
3353 {$IFDEF Win95}
3354 FMaskWidth:=FWidth;
3355 FMaskHeight:=FHeight;
3356 FMaskHandle:=CreateBitmap(FWidth,FHeight,1,1,Nil);
3357 If FMaskHandle=0 Then InvalidImage;
3358 FMaskPS:=CreateCompatibleDC(0);
3359 FOldMaskPalette:=SelectPalette(FMaskPS,FBitmapPal,True);
3360 FOldMaskBitmap:=SelectObject(FMaskPS,FMaskHandle);
3361 WinGDI.BitBlt(FMaskPS,0,0,FWidth,FHeight,FMaskPS,0,0,WHITENESS);
3362 {$ENDIF}
3363 {$IFDEF OS2}
3364 FMaskWidth:=FWidth;
3365 FMaskHeight:=FHeight*2;
3366
3367 FillChar(dop,SizeOf(DEVOPENSTRUC),0);
3368 pc:='DISPLAY';
3369 dop.pszDriverName:=@pc;
3370 DC := DevOpenDC(AppHandle,OD_MEMORY,'*',3,dop,0);
3371 If DC=0 Then InvalidImage;
3372 FMaskDC:=DC;
3373
3374 sizl.CX := 1;
3375 sizl.CY := 1;
3376 ps := GpiCreatePS(AppHandle,DC,sizl,PU_PELS Or GPIA_ASSOC Or GPIT_MICRO);
3377 If ps = GPI_ERROR Then InvalidImage;
3378 GpiCreateLogColorTable(ps,LCOL_RESET,LCOLF_RGB,0,0,Nil);
3379 FMaskPS:=ps;
3380
3381 With BIH Do
3382 Begin
3383 cbFix:=SizeOf(BITMAPINFOHEADER);
3384 CX:=FMaskWidth;
3385 CY:=FMaskHeight;
3386 cPlanes:=1;
3387 cBitCount:=1;
3388 End;
3389 FMaskHandle:=GpiCreateBitmap(FMaskPS,BIH,0,Nil,Nil);
3390 If FMaskHandle=0 Then InvalidImage;
3391
3392 FOldMaskBitmap:=GpiSetBitmap(FMaskPS,FMaskHandle);
3393 If FOldMaskBitmap = HBM_ERROR Then InvalidImage;
3394
3395 ptls[0].X:=0;
3396 ptls[0].Y:=0;
3397 ptls[1].X:=FWidth;
3398 ptls[1].Y:=FHeight;
3399 ptls[2].X:=0;
3400 ptls[2].Y:=0;
3401 ptls[3].X:=FWidth;
3402 ptls[3].Y:=FHeight;
3403 GpiBitBlt(FMaskPS,FMaskPS,4,ptls[0],ROP_ZERO,BBO_IGNORE);
3404
3405 ptls[0].X:=0;
3406 ptls[0].Y:=FHeight;
3407 ptls[1].X:=FWidth;
3408 ptls[1].Y:=FHeight*2;
3409 ptls[2].X:=0;
3410 ptls[2].Y:=FHeight;
3411 ptls[3].X:=FWidth;
3412 ptls[3].Y:=FHeight*2;
3413 GpiBitBlt(FMaskPS,FMaskPS,4,ptls[0],ROP_ONE,BBO_IGNORE);
3414 {$ENDIF}
3415
3416 FMaskCanvas.Create(Self);
3417 FMaskCanvas.Handle:=FMaskPS;
3418 FMaskCanvas.Init;
3419
3420 Update;
3421End;
3422
3423{
3424ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3425º º
3426º Speed-Pascal/2 Version 2.0 º
3427º º
3428º Speed-Pascal Component Classes (SPCC) º
3429º º
3430º This section: TPointer Class Implementation º
3431º º
3432º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
3433º º
3434ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
3435}
3436
3437
3438Procedure TPointer.InvalidImage;
3439Begin
3440 FIsInvalid:=True;
3441 ReleaseBitmap;
3442 Raise EInvalidCursor.Create(LoadNLSStr(SInvalidCursor));
3443End;
3444
3445Procedure TPointer.SetupComponent;
3446Begin
3447 Inherited SetupComponent;
3448
3449 Name:='Pointer';
3450End;
3451
3452{
3453ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3454º º
3455º Speed-Pascal/2 Version 2.0 º
3456º º
3457º Speed-Pascal Component Classes (SPCC) º
3458º º
3459º This section: TBitmapList Class Implementation º
3460º º
3461º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
3462º º
3463ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
3464}
3465
3466Function TBitmapList.CopyBitmap(original:TBitmap):TBitmap;
3467Var locClass:TBitmapClass;
3468Begin
3469 If original Is TBitmap Then
3470 Begin
3471 {Create local Bitmap}
3472 If FBitmapClass <> Nil Then locClass := BitmapClass
3473 Else locClass := original.ClassType;
3474 Result := locClass.Create;
3475 If Original.Owner<>Nil Then
3476 Begin
3477 Result.Owner:=Original.Owner;
3478 Original.Owner.InsertComponent(Result);
3479 End;
3480 Result.LoadFromBitmap(original);
3481 End
3482 Else Result := Nil;
3483End;
3484
3485
3486Function TBitmapList.GetBitmap(Index:LongInt):TBitmap;
3487Begin
3488 Result := Items[Index];
3489End;
3490
3491
3492Procedure TBitmapList.SetBitmap(Index:LongInt;Bitmap:TBitmap);
3493Var Item:TBitmap;
3494Begin
3495 Item := Items[Index];
3496 FreeItem(Item);
3497 Items[Index] := CopyBitmap(Bitmap);
3498End;
3499
3500
3501Procedure TBitmapList.FreeItem(Item:Pointer);
3502Var bmp:TBitmap;
3503Begin
3504 {Destroy local Bitmap}
3505 bmp := Item;
3506 If bmp Is TBitmap Then bmp.Destroy;
3507End;
3508
3509
3510Function TBitmapList.Add(Item:TBitmap):LongInt;
3511Begin
3512 If Not FDuplicates Then
3513 Begin
3514 Result := IndexOfOrigin(Item);
3515 If Result >= 0 Then Exit; {original found}
3516 End;
3517
3518 Result := TList.Add(CopyBitmap(Item));
3519End;
3520
3521
3522Function TBitmapList.AddResourceId(BmpId:LongWord):LongInt;
3523Var bmp:TBitmap;
3524Begin
3525 bmp.Create;
3526 bmp.LoadFromResourceId(BmpId);
3527 Result := Add(bmp); {creates A local Copy}
3528 bmp.Destroy; {#}
3529End;
3530
3531
3532Function TBitmapList.AddResourceName(Const Name:String):LongInt;
3533Var bmp:TBitmap;
3534Begin
3535 bmp.Create;
3536 bmp.LoadFromResourceName(Name);
3537 Result := Add(bmp); {creates A local Copy}
3538 bmp.Destroy; {#}
3539End;
3540
3541
3542Procedure TBitmapList.Insert(Index:LongInt;Item:TBitmap);
3543Begin
3544 TList.Insert(Index,CopyBitmap(Item));
3545End;
3546
3547
3548Function TBitmapList.IndexOfOrigin(Item:TBitmap):LongInt;
3549Var locBitmap:TBitmap;
3550Begin
3551 For Result := 0 To Count-1 Do
3552 Begin
3553 locBitmap := Items[Result];
3554 If locBitmap <> Nil Then
3555 If locBitmap.IsEqual(Item) Then Exit;
3556 End;
3557 Result := -1;
3558End;
3559
3560{
3561ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3562º º
3563º Speed-Pascal/2 Version 2.0 º
3564º º
3565º Speed-Pascal Component Classes (SPCC) º
3566º º
3567º This section: TImageList Class Implementation º
3568º º
3569º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
3570º º
3571ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
3572}
3573
3574
3575Function TImageList.NewItem:PImageItem;
3576Begin
3577 New(Result);
3578End;
3579
3580Function TImageList.Add(Image,Mask:TBitmap):LongInt;
3581Var Item:PImageItem;
3582Begin
3583 Item:=NewItem;
3584 Item^.Bitmap:=Image.Copy;
3585 If Mask<>Nil Then Item^.Mask:=Mask.Copy;
3586 Result:=FList.Add(Item);
3587 Change;
3588End;
3589
3590Function TImageList.AddIcon(Image:TIcon):LongInt;
3591Var Item:PImageItem;
3592Begin
3593 Item:=NewItem;
3594 Item^.Icon:=TIcon(Image.Copy);
3595 Result:=FList.Add(Item);
3596 Change;
3597End;
3598
3599Procedure TImageList.AddImages(Value:TImageList);
3600Var t:LongInt;
3601 Item,Item1:PImageItem;
3602Begin
3603 If Value<>Nil Then For t:=0 To Value.Count-1 Do
3604 Begin
3605 Item:=Value.FList[t];
3606 Item1:=NewItem;
3607 If Item^.Bitmap<>Nil Then Item1^.Bitmap:=Item^.Bitmap.Copy;
3608 If Item^.Mask<>Nil Then Item1^.Mask:=Item^.Mask.Copy;
3609 If Item^.Icon<>Nil Then Item1^.Icon:=TIcon(Item^.Icon.Copy);
3610
3611 FList.Add(Item1);
3612 End;
3613 Change;
3614End;
3615
3616Procedure TImageList.Initialize;
3617Begin
3618 FImageType:=itImage;
3619 FMasked:=False;
3620
3621 FList.Create;
3622 FList.ImageList:=Self;
3623End;
3624
3625Procedure TImageList.SetupComponent;
3626Begin
3627 Inherited SetupComponent;
3628 Name:='ImageList';
3629
3630 Include(ComponentState, csHandleLinks);
3631 Initialize;
3632End;
3633
3634Procedure TImageList.DisposeItem(Item:PImageItem);
3635Begin
3636 Dispose(Item);
3637End;
3638
3639Procedure TImageList.Clear;
3640Var t:LongInt;
3641 Item:PImageItem;
3642Begin
3643 For t:=0 To FList.Count-1 Do
3644 Begin
3645 Item:=FList[t];
3646 If Item^.Bitmap<>Nil Then Item^.Bitmap.Destroy;
3647 If Item^.Mask<>Nil Then Item^.Mask.Destroy;
3648 If Item^.Icon<>Nil Then Item^.Icon.Destroy;
3649 DisposeItem(Item);
3650 End;
3651 FList.Clear;
3652 Change;
3653End;
3654
3655Destructor TImageList.Destroy;
3656Begin
3657 Clear;
3658 FList.Destroy;
3659 Inherited Destroy;
3660End;
3661
3662Procedure TImageList.Change;
3663Begin
3664 If FOnChange<>Nil Then FOnChange(Self);
3665End;
3666
3667Function TImageList.GetCount:LongInt;
3668Begin
3669 Result:=FList.Count;
3670End;
3671
3672Procedure TImageList.Delete(Index:LongInt);
3673Var Item:PImageItem;
3674Begin
3675 Item:=FList[Index];
3676 FList.Delete(Index);
3677 If Item^.Bitmap<>Nil Then Item^.Bitmap.Destroy;
3678 If Item^.Mask<>Nil Then Item^.Mask.Destroy;
3679 If Item^.Icon<>Nil Then Item^.Icon.Destroy;
3680 DisposeItem(Item);
3681End;
3682
3683Procedure TImageList.Replace(Index:LongInt;Image,Mask:TBitmap);
3684Var Item:PImageItem;
3685Begin
3686 Item:=FList[Index];
3687 If Item^.Bitmap<>Nil Then Item^.Bitmap.Destroy;
3688 If Item^.Mask<>Nil Then Item^.Mask.Destroy;
3689 Item^.Bitmap:=Image.Copy;
3690 If Mask<>Nil Then Item^.Mask:=Mask.Copy
3691 Else Item^.Mask:=Nil;
3692End;
3693
3694Procedure TImageList.ReplaceIcon(Index:LongInt;Image:TIcon);
3695Var Item:PImageItem;
3696Begin
3697 Item:=FList[Index];
3698 If Item^.Icon<>Nil Then Item^.Icon.Destroy;
3699 Item^.Icon:=TIcon(Image.Copy);
3700End;
3701
3702Procedure TImageList.Insert(Index:LongInt;Image,Mask:TBitmap);
3703Var Item:PImageItem;
3704Begin
3705 Item:=NewItem;
3706 Item^.Bitmap:=Image.Copy;
3707 If Mask<>Nil Then Item^.Mask:=Mask.Copy;
3708 FList.Insert(Index,Item);
3709End;
3710
3711Procedure TImageList.InsertIcon(Index:LongInt;Image:TIcon);
3712Var Item:PImageItem;
3713Begin
3714 Item:=NewItem;
3715 Item^.Icon:=TIcon(Image.Copy);
3716 FList.Insert(Index,Item);
3717End;
3718
3719Procedure TImageList.GetBitmap(Index:LongInt;Image:TBitmap);
3720Begin
3721 Image.LoadFromBitmap(PImageItem(FList[Index])^.Bitmap);
3722End;
3723
3724Function TImageList.GetBitmapReference( Index:LongInt ): TBitmap;
3725Begin
3726 Result := PImageItem( FList[ Index ] )^.Bitmap;
3727End;
3728
3729Procedure TImageList.GetIcon(Index: Integer;Icon:TIcon);
3730Begin
3731 Icon.LoadFromBitmap(PImageItem(FList[Index])^.Icon);
3732End;
3733
3734Procedure TImageList.GetMask(Index:LongInt;Mask:TBitmap);
3735Begin
3736 Mask.LoadFromBitmap(PImageItem(FList[Index])^.Mask);
3737End;
3738
3739Procedure TImageList.Move(CurIndex,NewIndex:LongInt);
3740Begin
3741 FList.Move(CurIndex,NewIndex);
3742End;
3743
3744Procedure TImageList.Draw(Canvas:TCanvas;X,Y,Index:LongInt);
3745Var Bitmap,Mask:TBitmap;
3746 Source,Dest:TRect;
3747Begin
3748 Bitmap.Create;
3749 Try
3750 If ImageType=itImage Then GetBitmap(Index,Bitmap)
3751 Else GetMask(Index,Bitmap);
3752 Except
3753 Bitmap.Destroy;
3754 Bitmap:=Nil;
3755 End;
3756 If Bitmap=Nil Then exit;
3757 If Bitmap.Empty Then
3758 Begin
3759 Bitmap.Destroy;
3760 exit;
3761 End;
3762
3763 Dest.Left:=X;
3764 Dest.Bottom:=Y;
3765 Dest.Right:=Dest.Left+Bitmap.Width;
3766 Dest.Top:=Dest.Bottom+Bitmap.Height;
3767 If ImageType=itImage Then
3768 Begin
3769 If Masked Then
3770 Begin
3771 Mask.Create;
3772 Try
3773 GetMask(Index,Mask)
3774 Except
3775 Mask.Destroy;
3776 Mask:=Nil;
3777 End;
3778 If Mask=Nil Then
3779 Begin
3780 Bitmap.Destroy;
3781 exit;
3782 End;
3783 If Mask.Empty Then
3784 Begin
3785 Mask.Destroy;
3786 Bitmap.Draw(Canvas,Dest);
3787 Bitmap.Destroy;
3788 exit;
3789 End;
3790
3791 Source.Left:=0;
3792 Source.Right:=Mask.Width;
3793 Source.Bottom:=0;
3794 Source.Top:=Mask.Height;
3795 Mask.Canvas.BitBlt(Canvas,Dest,Source,cmSrcAnd,bitfIgnore);
3796 Source.Right:=Bitmap.Width;
3797 Source.Top:=Bitmap.Height;
3798 Bitmap.Canvas.BitBlt(Canvas,Dest,Source,cmSrcPaint,bitfIgnore);
3799 Mask.Destroy;
3800 End
3801 Else Bitmap.Draw(Canvas,Dest);
3802 End
3803 Else Bitmap.Draw(Canvas,Dest);
3804 Bitmap.Destroy;
3805End;
3806
3807Procedure TImageList.SetList(Item:TImageItemList);
3808Begin
3809 If Item<>Nil Then If FList<>Item Then
3810 Begin
3811 FList.Destroy;
3812 FList:=Item;
3813 End;
3814End;
3815
3816Procedure TImageList.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
3817Var Count,t,l:LongInt;
3818 pl:^LONGINT;
3819 p:Pointer;
3820 Item:PImageItem;
3821
3822 Procedure ReadImage(Var Bitmap:TBitmap;IsIcon:Boolean);
3823 Begin
3824 l:=pl^;
3825 inc(pl,4);
3826 If l<>0 Then
3827 Begin
3828 GetMem(p,l);
3829 System.Move(pl^,p^,l);
3830 inc(pl,l);
3831 If IsIcon Then Bitmap:=TIcon.Create
3832 Else Bitmap:=TBitmap.Create;
3833 Bitmap.LoadFromMem(p^,l);
3834 FreeMem(p,l);
3835 End;
3836 End;
3837
3838Begin
3839 If ResName=rnBitmapList Then
3840 Begin
3841 pl:=@Data;
3842 Count:=pl^;
3843 inc(pl,4);
3844 For t:=0 To Count-1 Do
3845 Begin
3846 Item:=NewItem;
3847
3848 ReadImage(Item^.Bitmap,False);
3849 ReadImage(Item^.Mask,False);
3850 ReadImage(Item^.Icon,True);
3851
3852 FList.Add(Item);
3853 End;
3854 End
3855 Else Inherited ReadSCUResource(ResName,Data,DataLen);
3856End;
3857
3858Function TImageList.WriteSCUResource(Stream:TResourceStream):Boolean;
3859Var MemStream:TMemoryStream;
3860 t:LONGINT;
3861 Item:PImageItem;
3862
3863 Procedure WriteImage(Bitmap:TBitmap);
3864 Var tt:Longint;
3865 BStream:TMemoryStream;
3866 Begin
3867 tt:=0;
3868 If Bitmap=Nil Then MemStream.Write(tt,4)
3869 Else
3870 Begin
3871 BStream.Create;
3872 Try
3873 Bitmap.SaveToStream(BStream);
3874 tt:=BStream.Size;
3875 MemStream.Write(tt,4);
3876 MemStream.Write(BStream.Memory^,BStream.Size);
3877 Finally
3878 BStream.Destroy;
3879 End;
3880 End;
3881 End;
3882
3883Begin
3884 result:=Inherited WriteSCUResource(Stream);
3885 If not result Then exit;
3886
3887 MemStream.Create;
3888
3889 t:=FList.Count;
3890 MemStream.Write(t,4);
3891
3892 For t:=0 To FList.Count-1 Do
3893 Begin
3894 Item:=FList[t];
3895 Try
3896 WriteImage(Item^.Bitmap);
3897 WriteImage(Item^.Mask);
3898 WriteImage(Item^.Icon);
3899 Except
3900 MemStream.Destroy;
3901 MemStream:=Nil;
3902 t:=FList.Count-1;
3903 End;
3904 End;
3905
3906 If MemStream<>Nil Then
3907 Begin
3908 result:=Stream.NewResourceEntry(rnBitmapList,MemStream.Memory^,MemStream.Size);
3909 MemStream.Destroy;
3910 End
3911 Else Result:=False;
3912End;
3913
3914{
3915ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3916º º
3917º Speed-Pascal/2 Version 2.0 º
3918º º
3919º Speed-Pascal Component Classes (SPCC) º
3920º º
3921º This section: TMetaFileCanvas Class Implementation º
3922º º
3923º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
3924º completed by Martin Vieregg www.hypermake.de (3/2004) º º
3925º º
3926ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
3927}
3928
3929Constructor TMetaFileCanvas.Create(AMetafile: TMetafile);
3930{$IFDEF OS2}
3931Var sizlPage:SIZEL;
3932{$ENDIF}
3933Begin
3934 If ((AMetaFile=Nil)Or(AMetaFile.FMetaFileCanvas<>Nil)) Then Fail;
3935
3936 Inherited Create(AMetaFile);
3937 Include(ComponentState, csDetail);
3938 {$IFDEF OS2}
3939 sizlPage.CX:=0;
3940 sizlPage.CY:=0;
3941 Handle := GpiCreatePS(AppHandle,AMetaFile.FDeviceHandle,sizlPage,
3942 PU_PELS OR GPIA_ASSOC);
3943 GpiCreateLogColorTable(Handle,LCOL_RESET,LCOLF_RGB,0,0,Nil);
3944 {$ENDIF}
3945 Init;
3946 FMetaFile:=AMetaFile;
3947 FMetaFile.FMetaFileCanvas:=Self;
3948End;
3949
3950Destructor TMetaFileCanvas.Destroy;
3951Begin
3952 {$IFDEF OS2}
3953 If Handle<>0 Then
3954 Begin
3955 GpiAssociate(Handle,0);
3956 GpiDestroyPS(Handle);
3957 Handle:=0;
3958 End;
3959 {$ENDIF}
3960 FMetaFile.FMetaFileCanvas:=Nil;
3961End;
3962
3963{
3964ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3965º º
3966º Speed-Pascal/2 Version 2.0 º
3967º º
3968º Speed-Pascal Component Classes (SPCC) º
3969º º
3970º This section: TMetaFile Class Implementation º
3971º º
3972º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
3973º º
3974ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
3975}
3976
3977Function TMetaFile.GetEmpty: Boolean;
3978Begin
3979 //not implemented yet
3980 Result:=False;
3981End;
3982
3983const
3984 co : longword = 22;
3985
3986Function TMetaFile.GetHeight:LongInt;
3987 var
3988 Size : PSIZEL;
3989 P : Pointer;
3990 len : longint;
3991Begin
3992 Len:=GpiQueryMetaFileLength(FHandle);
3993 GetMem(p,Len);
3994 GpiQueryMetaFileBits(FHandle,0,Len,p^);
3995 size := p+co;
3996 result := size^.cy;
3997 //result := 200;
3998 FreeMem(p,Len);
3999
4000End;
4001
4002Function TMetaFile.GetWidth:LongInt;
4003 var
4004 Size : PSIZEL;
4005 P : Pointer;
4006 len : longint;
4007Begin
4008 Len:=GpiQueryMetaFileLength(FHandle);
4009 GetMem(p,Len);
4010 GpiQueryMetaFileBits(FHandle,0,Len,p^);
4011 size := p+co;
4012 result := size^.cx;
4013 //result := 200;
4014 FreeMem(p,Len);
4015
4016End;
4017
4018Procedure TMetaFile.Assign(Source:TPersistent);
4019Begin
4020 If Source Is TMetaFile Then
4021 Begin
4022 If FMetaFileCanvas<>Nil Then FMetaFileCanvas.Destroy;
4023 {$IFDEF OS2}
4024 If FDeviceHandle<>0 Then DevCloseDC(FDeviceHandle);
4025 FDeviceHandle:=0;
4026 If FHandle<>0 Then GpiDeleteMetaFile(FHandle);
4027 FHandle:=0;
4028 If TMetaFile(Source).FHandle<>0 Then
4029 FHandle:=GpiCopyMetaFile(TMetaFile(Source).FHandle);
4030 {$ENDIF}
4031 End
4032 Else Inherited Assign(Source);
4033End;
4034
4035(*
4036
4037alOpt[PMF_SEGBASE] = 0; /* Reserved */
4038alOpt[PMF_LOADTYPE] = LT_DEFAULT; /* Default transformations */
4039alOpt[PMF_RESOLVE] = 0; /* Reserved */
4040alOpt[PMF_LCIDS] = LC_DEFAULT; /* Uses default lcids */
4041alOpt[PMF_RESET] = RES_DEFAULT; /* Uses default */
4042alOpt[PMF_SUPPRESS] = SUP_DEFAULT; /* Uses default */
4043alOpt[PMF_COLORTABLES] = CTAB_DEFAULT; /* Uses default */
4044alOpt[PMF_COLORREALIZABLE] = CREA_DEFAULT; /* Uses default */
4045
4046GpiPlayMetaFile(hps, /* Plays metafile onto screen */
4047hmf, 8L, alOpt, (PLONG) NULL, 0L, (PSZ) NULL);
4048} /* fncMETA02 */
4049
4050
4051*)
4052
4053{Martin: a lot of stuff was missing here}
4054{$HINTS OFF}
4055
4056Procedure TMetaFile.GetOriginalRect(Var Rect: RECTL);
4057{$IFDEF OS2}
4058Var alOpt:Array[0..8] Of LongInt;
4059 L : Long;
4060 xyRect : RECTL;
4061 Boundary: RECTL;
4062 Size : SIZEL;
4063 flOptions : ULONG;
4064 dc: HDC;
4065 ps: HPS;
4066 lSegCount: LONG;
4067{$ENDIF}
4068Begin
4069{$IFDEF OS2}
4070 PS := WinGetScreenPS( HWND_DESKTOP );
4071 alOpt[PMF_SEGBASE]:=0;
4072 alOpt[PMF_LOADTYPE]:=LT_NOMODIFY; // current (default) transform
4073 alOpt[PMF_RESOLVE]:=0;
4074 alOpt[PMF_LCIDS]:=LC_LOADDISC ; // load bitmaps and fonts was LC_DEFAULT; // don't load bitmaps & fonts (??)
4075 alOpt[PMF_RESET]:=RES_NORESET; // don't reset Pres space
4076 alOpt[PMF_SUPPRESS]:=SUP_NOSUPPRESS; // really draw
4077 alOpt[PMF_COLORTABLES]:=(*CTAB_DEFAULT*)CTAB_REPLACE; // load color table
4078 alOpt[PMF_COLORREALIZABLE]:=CREA_DEFAULT; // irrelevant in 32 bit land
4079 alOpt[PMF_DEFAULTS]:= DDEF_LOADDISC;
4080
4081 // reset boundaries
4082 GpiResetBoundaryData ( ps );
4083
4084 // note boundary returned in MODEL coordinates
4085 GpiSetDrawControl ( ps, DCTL_BOUNDARY, DCTL_ON ); // accumulate boundary data
4086 GpiSetDrawControl ( ps, DCTL_DISPLAY, DCTL_OFF ); // turn display off
4087
4088 l := GpiQueryDrawControl ( ps, DCTL_BOUNDARY ); // accumulate boundary data
4089
4090 GpiPlayMetaFile(ps, FHandle,9,alOpt[0],lSegCount,0,Nil);
4091
4092 l := GpiQueryDrawControl ( ps, DCTL_BOUNDARY ); // accumulate boundary data
4093
4094 GpiQueryBoundaryData( ps, Boundary );
4095
4096 GpiSetDrawControl ( ps, DCTL_BOUNDARY, DCTL_OFF ); // stop accumulating boundary data
4097 GpiSetDrawControl ( ps, DCTL_DISPLAY, DCTL_ON ); // turn display on
4098
4099 WinReleasePS( ps );
4100 {$ENDIF}
4101End;
4102{$HINTS ON}
4103
4104Procedure TMetaFile.Draw(ACanvas: TCanvas;Const Rect: TRect);
4105{$IFDEF OS2}
4106Var alOpt:Array[0..8] Of LongInt;
4107 L : Long;
4108 xyRect : RECTL;
4109 Boundary: RECTL;
4110 Size : SIZEL;
4111 flOptions : ULONG;
4112{$ENDIF}
4113Begin
4114 {$IFDEF OS2}
4115 If FHandle=0 Then
4116 Begin
4117 FHandle:=DevCloseDC(FDeviceHandle);
4118 FDeviceHandle:=0;
4119 End;
4120
4121 GetOriginalRect( xyRect );
4122 GpiResetPS (ACanvas.Handle, GRES_ALL ); // GRES_ATTRS);
4123
4124 alOpt[PMF_SEGBASE]:=0;
4125 alOpt[PMF_LOADTYPE]:=LT_ORIGINALVIEW; // Use original transform
4126 alOpt[PMF_RESOLVE]:=0;
4127 alOpt[PMF_LCIDS]:=LC_LOADDISC ; // load bitmaps and fonts was LC_DEFAULT; // don't load bitmaps & fonts (??)
4128 alOpt[PMF_RESET]:=RES_RESET; // reset Pres space
4129 alOpt[PMF_SUPPRESS]:=SUP_SUPPRESS; // don't really draw yet!
4130 alOpt[PMF_COLORTABLES]:=(*CTAB_DEFAULT*)CTAB_REPLACE; // load color table
4131 alOpt[PMF_COLORREALIZABLE]:=CREA_DEFAULT; // irrelevant in 32 bit land
4132 alOpt[PMF_DEFAULTS]:= DDEF_LOADDISC;
4133
4134 // "play" - just reset PS values to original defaults
4135 L := GpiPlayMetaFile(ACanvas.Handle,FHandle,9,alOpt[0],Nil,0,Nil);
4136
4137 // reset boundary calculations.
4138 if not GpiResetBoundaryData ( ACanvas.Handle ) then
4139 L := WInGetLastError( AppHandle );
4140
4141 ACanvas.Line( 0, 0, 500, 500 );
4142 // note boundary returned in MODEL coordinates
4143 if not GpiSetDrawControl ( ACanvas.Handle, DCTL_BOUNDARY, DCTL_ON ) // accumulate boundary data
4144 then
4145 L := WInGetLastError( AppHandle );
4146 if not GpiSetDrawControl ( ACanvas.Handle, DCTL_DISPLAY, DCTL_OFF ) // turn display off
4147 then
4148 L := WInGetLastError( AppHandle );
4149
4150 // Now adjust the page viewport
4151
4152 // pmgpi
4153// xyRect := RECTL (Rect);
4154 (*GpiSetViewingLimits*)
4155// if not GpiSetPageViewport (ACanvas.Handle, xyRect) then
4156// L := WinGetLastError( AppHandle );
4157
4158 // now draw
4159 alOpt[PMF_SUPPRESS]:=SUP_NOSUPPRESS; // don't really draw yet!
4160 alOpt[PMF_RESET]:=RES_NORESET; // don't reset PS again
4161 L := GpiPlayMetaFile(ACanvas.Handle,FHandle,9,alOpt[0],Nil,0,Nil);
4162 If L = GPI_ERROR then
4163 L := WinGetLastError( AppHandle );
4164
4165 if not GpiQueryBoundaryData( ACanvas.Handle,Boundary) then
4166 L := WInGetLastError( AppHandle );
4167
4168 if not GpiSetDrawControl ( ACanvas.Handle, DCTL_BOUNDARY, DCTL_OFF )// stop accumulating boundary data
4169 then
4170 L := WInGetLastError( AppHandle );
4171
4172 if not GpiSetDrawControl ( ACanvas.Handle, DCTL_DISPLAY, DCTL_ON ) // turn display on
4173 then
4174 L := WInGetLastError( AppHandle );
4175
4176 (*xyRect.xLeft := 0;
4177 xyRect.yBottom := 0;
4178 //if (FWidth = 0) or (FHeight = 0) then Beep (100, 100);
4179 xyRect.xRight := FWidth;
4180 xyRect.yTop:= FHeight;*)
4181 //if you do not use this function, the Metafile is drawn in original size
4182// GpiSetPageViewport (ACanvas.Handle, xyRect);
4183
4184 (*
4185 flOptions := PU_ARBITRARY OR /* arbitrary units. */
4186 GPIF_DEFAULT; /* normal ps format. */
4187 Size.cx := 100;
4188 Size.cy := 100;
4189 if GpiSetPS (ACanvas.Handle, Size, flOptions) then Beep (1000, 100) else Beep (50, 100);*)
4190
4191// alOpt[PMF_RESET]:=RES_DEFAULT;
4192// alOpt[PMF_SUPPRESS]:=SUP_DEFAULT;
4193 //alOpt[PMF_DEFAULTS]:= DDEF_LOADDISC;
4194// L := GpiPlayMetaFile(ACanvas.Handle,FHandle,8,alOpt[0],Nil,0,Nil);
4195 (*if L = GPI_ERROR then Beep (50, 200)
4196 else if L = GPI_HITS then Beep (400, 200)
4197 else if L = GPI_OK then Beep (2000, 200);*)
4198 {$ENDIF}
4199End;
4200{$HINTS ON}
4201
4202{$HINTS OFF}
4203Procedure TMetaFile.SetHeight(Value:LongInt);
4204Begin
4205 //not implemented yet
4206 //FHeight := Value;
4207End;
4208
4209Procedure TMetaFile.SetWidth(Value:LongInt);
4210Begin
4211 //not implemented yet
4212 //FWidth := Value;
4213End;
4214{$HINTS ON}
4215
4216Procedure TMetaFile.SetupComponent;
4217{$IFDEF OS2}
4218Var dop:DEVOPENSTRUC;
4219 pc:CString;
4220{$ENDIF}
4221Begin
4222 Inherited SetupComponent;
4223
4224 {$IFDEF OS2}
4225 FillChar(dop,SizeOf(DEVOPENSTRUC),0);
4226 pc:='DISPLAY';
4227 dop.pszDriverName:=@pc;
4228 FDeviceHandle:=DevOpenDC(AppHandle,OD_METAFILE,'*',2,dop,0);
4229 {$ENDIF}
4230End;
4231
4232Destructor TMetaFile.Destroy;
4233Begin
4234 If FMetaFileCanvas<>Nil Then FMetaFileCanvas.Destroy;
4235 {$IFDEF OS2}
4236 If FDeviceHandle<>0 Then DevCloseDC(FDeviceHandle);
4237 FDeviceHandle:=0;
4238 If FHandle<>0 Then GpiDeleteMetaFile(FHandle);
4239 FHandle:=0;
4240 {$ENDIF}
4241End;
4242
4243Function TMetaFile.GetHandle:LongWord;
4244Begin
4245 Result:=FHandle;
4246End;
4247
4248Procedure TMetaFile.LoadFromFile(Const FileName:String);
4249Begin
4250 {$IFDEF OS2}
4251 FHandle:=GpiLoadMetaFile(AppHandle,FileName);
4252 {$ENDIF}
4253End;
4254
4255Procedure TMetaFile.SaveToFile(Const Filename: String);
4256Begin
4257 {$IFDEF OS2}
4258 If FHandle=0 Then
4259 Begin
4260 If FMetaFileCanvas<>Nil Then GpiAssociate(FMetaFileCanvas.Handle,0);
4261 FHandle:=DevCloseDC(FDeviceHandle);
4262 FDeviceHandle:=0;
4263 End;
4264 GpiSaveMetaFile(FHandle,FileName);
4265 {$ENDIF}
4266End;
4267
4268Procedure TMetaFile.LoadFromStream(Stream: TStream);
4269Var p:Pointer;
4270 Len:LongInt;
4271Begin
4272 {$IFDEF OS2}
4273 Len:=Stream.Size-Stream.Position;
4274 GetMem(p,Len);
4275 Stream.Read(p^,Stream.Size-Stream.Position);
4276 If FHandle=0 Then
4277 Begin
4278 If FMetaFileCanvas<>Nil Then GpiAssociate(FMetaFileCanvas.Handle,0);
4279 FHandle:=DevCloseDC(FDeviceHandle);
4280 FDeviceHandle:=0;
4281 End;
4282 GpiSetMetaFileBits(FHandle,0,Len,p^);
4283 FreeMem(p,Len);
4284 {$ENDIF}
4285End;
4286
4287Procedure TMetaFile.SaveToStream(Stream: TStream);
4288Var p:Pointer;
4289 Len:LongInt;
4290Begin
4291 {$IFDEF OS2}
4292 If FHandle=0 Then
4293 Begin
4294 If FMetaFileCanvas<>Nil Then GpiAssociate(FMetaFileCanvas.Handle,0);
4295 FHandle:=DevCloseDC(FDeviceHandle);
4296 FDeviceHandle:=0;
4297 End;
4298 Len:=GpiQueryMetaFileLength(FHandle);
4299 GetMem(p,Len);
4300 GpiQueryMetaFileBits(FHandle,0,Len,p^);
4301 Stream.Write(p^,Len);
4302 FreeMem(p,Len);
4303 {$ENDIF}
4304End;
4305
4306Function TMetaFile.CopyGraphic:TGraphic;
4307Begin
4308 Result:=TMetaFile.Create;
4309 {$IFDEF OS2}
4310 If FHandle=0 Then
4311 Begin
4312 If FMetaFileCanvas<>Nil Then GpiAssociate(FMetaFileCanvas.Handle,0);
4313 FHandle:=DevCloseDC(FDeviceHandle);
4314 FDeviceHandle:=0;
4315 End;
4316 TMetaFile(Result).FHandle:=GpiCopyMetaFile(FHandle);
4317 {$ENDIF}
4318End;
4319
4320Procedure TMetaFile.LoadFromHandle(Handle:LongWord);
4321Begin
4322 {$IFDEF OS2}
4323 If FHandle<>0 Then GpiDeleteMetaFile(FHandle);
4324 FHandle:=GpiCopyMetaFile(Handle);
4325 {$ENDIF}
4326End;
4327
4328{Martin}
4329Function TMetaFile.LoadFromClipBoard:Boolean;
4330Var hbmClipbrd:LongWord;
4331Begin
4332 //FIsInvalid:=False; //reset flag !
4333
4334{
4335 // requires FP4? - AaronL
4336 Result:=False;
4337 Clipboard.Open(Handle);
4338 If Clipboard.IsFormatAvailable(cfMetafile) Then
4339 Begin
4340 hbmClipbrd:=Clipboard.GetAsHandle(cfMetafile);
4341 If hbmClipbrd<>0 Then
4342 Begin
4343 LoadFromHandle(hbmClipbrd);
4344 Result:=Not Empty;
4345 End;
4346 End;
4347
4348 Clipboard.Close;
4349}
4350
4351End;
4352
4353
4354
4355Function TMetaFile.GetCanvas:TCanvas;
4356Begin
4357 Result:=TCanvas(FMetaFileCanvas);
4358End;
4359
4360Function TMetaFile.GetSize:LongInt;
4361Begin
4362 {$IFDEF OS2}
4363 If FHandle<>0 Then Result:=GpiQueryMetaFileLength(FHandle)
4364 Else Result:=0;
4365 {$ENDIF}
4366End;
4367
4368{$HINTS OFF}
4369Procedure TMetaFile.PaletteChanged;
4370Begin
4371 //not implemented yet
4372End;
4373{$HINTS ON}
4374
4375{$HINTS OFF}
4376Procedure TMetaFile.CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);
4377{$IFDEF OS2}
4378Var dop:DEVOPENSTRUC;
4379 pc:CString;
4380{$ENDIF}
4381Begin
4382 {$IFDEF OS2}
4383 If FMetaFileCanvas<>Nil Then FMetaFileCanvas.Destroy;
4384 If FDeviceHandle<>0 Then DevCloseDC(FDeviceHandle);
4385 FDeviceHandle:=0;
4386 If FHandle<>0 Then GpiDeleteMetaFile(FHandle);
4387 FHandle:=0;
4388 FillChar(dop,SizeOf(DEVOPENSTRUC),0);
4389 pc:='DISPLAY';
4390 dop.pszDriverName:=@pc;
4391 FDeviceHandle:=DevOpenDC(AppHandle,OD_METAFILE,'*',2,dop,0);
4392 {$ENDIF}
4393End;
4394{$HINTS ON}
4395
4396{$HINTS OFF}
4397Function TMetaFile.CreateMask(Color:TColor):TGraphic;
4398Begin
4399 //not supported yet
4400 Result:=Nil;
4401End;
4402{$HINTS ON}
4403
4404{$HINTS OFF}
4405Procedure TMetaFile.PartialDraw(Canvas:TCanvas;Const Src,Dest:TRect);
4406Begin
4407 //not supported yet
4408End;
4409{$HINTS ON}
4410
4411{
4412ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
4413º º
4414º Speed-Pascal/2 Version 2.0 º
4415º º
4416º Speed-Pascal Component Classes (SPCC) º
4417º º
4418º This section: TPicture Class Implementation º
4419º º
4420º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
4421º º
4422ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
4423}
4424
4425Function TPicture.GetBitmap:TBitmap;
4426Begin
4427 ForceType(TBitmap);
4428 Result:=TBitmap(FGraphic);
4429End;
4430
4431Function TPicture.GetEmpty:Boolean;
4432Begin
4433 Result:=FGraphic=Nil;
4434End;
4435
4436Function TPicture.HasFormat(GraphicClass:TGraphicClass):Boolean;
4437Begin
4438 Result:=FGraphic Is GraphicClass;
4439End;
4440
4441Function TPicture.GetHeight:LongInt;
4442Begin
4443 If FGraphic<>Nil Then Result:=FGraphic.Height
4444 Else Result:=0;
4445End;
4446
4447Procedure TPicture.AssignTo(Dest:TPersistent);
4448Begin
4449 If FGraphic Is Dest.ClassType Then Dest.Assign(FGraphic)
4450 Else Inherited AssignTo(Dest);
4451End;
4452
4453Procedure TPicture.Assign(Source:TPersistent);
4454Begin
4455 If Source=Nil then Graphic:=Nil
4456 Else If Source Is TGraphic Then Graphic:=TGraphic(Source)
4457 Else If Source Is TPicture Then Graphic:=TPicture(Source).Graphic
4458 Else Inherited Assign(Source);
4459End;
4460
4461Function TPicture.GetIcon:TIcon;
4462Begin
4463 ForceType(TIcon);
4464 Result:=TIcon(FGraphic);
4465End;
4466
4467Function TPicture.GetMetafile:TMetafile;
4468Begin
4469 ForceType(TMetaFile);
4470 Result:=TMetaFile(FGraphic);
4471End;
4472
4473Function TPicture.GetWidth:LongInt;
4474Begin
4475 If FGraphic<>Nil Then Result:=FGraphic.Width
4476 Else Result:=0;
4477End;
4478
4479Procedure TPicture.SetBitmap(Value: TBitmap);
4480Begin
4481 SetGraphic(Value);
4482End;
4483
4484Procedure TPicture.SetIcon(Value: TIcon);
4485Begin
4486 SetGraphic(Value);
4487End;
4488
4489Procedure TPicture.SetMetafile(Value: TMetafile);
4490Begin
4491 SetGraphic(Value);
4492End;
4493
4494Procedure TPicture.SetGraphic(Value: TGraphic);
4495Var NewGraphic:TGraphic;
4496Begin
4497 // do not destroy the graphic object changed by the inspector
4498 If FGraphic <> Value Then
4499 Begin
4500 If Value <> Nil Then
4501 Begin
4502 NewGraphic := Value.CopyGraphic;
4503 NewGraphic.OnChange := Changed;
4504 End
4505 Else NewGraphic := Nil;
4506
4507 If FGraphic <> Nil Then FGraphic.Destroy;
4508 FGraphic := NewGraphic;
4509 Changed(Self);
4510 End;
4511End;
4512
4513Procedure TPicture.Changed(Sender: TObject);
4514Begin
4515 If FOnChange<>Nil Then FOnChange(Self);
4516End;
4517
4518
4519Destructor TPicture.Destroy;
4520Begin
4521 If FGraphic<>Nil Then FGraphic.Destroy;
4522 Inherited Destroy;
4523End;
4524
4525Procedure TPicture.LoadFromFile(Const Filename:String);
4526Var Ext:String;
4527 aClass:TGraphicClass;
4528 NewGraphic:TGraphic;
4529Begin
4530 Ext := ExtractFileExt(FileName);
4531 UpcaseStr(Ext);
4532 aClass:=Nil;
4533 If Ext='.BMP' Then aClass:=TBitmap
4534 Else If Ext='.ICO' Then aClass:=TIcon
4535 Else If Ext='.MET' Then aClass:=TMetaFile;
4536 If aClass=Nil Then Raise EInvalidPictureFormat.Create('Unknown extension');
4537
4538 NewGraphic := aClass.Create;
4539 NewGraphic.LoadFromFile(FileName);
4540
4541 If FGraphic <> Nil Then FGraphic.Destroy;
4542 FGraphic := NewGraphic;
4543 FGraphic.OnChange := Changed;
4544 Changed(Self);
4545End;
4546
4547
4548Procedure TPicture.SaveToFile(Const Filename:String);
4549Begin
4550 If FGraphic<>Nil Then FGraphic.SaveToFile(FileName);
4551End;
4552
4553
4554Procedure TPicture.ForceType(GraphicType:TGraphicClass);
4555Begin
4556 If not (FGraphic Is GraphicType) Then
4557 Begin
4558 If FGraphic <> Nil Then FGraphic.Destroy;
4559 FGraphic := GraphicType.Create;
4560 FGraphic.OnChange := Changed;
4561 Changed(Self);
4562 End;
4563End;
4564
4565
4566//unit initalization
4567
4568Type TIconClass=Class Of TIcon;
4569
4570Var IconClass:TIconClass;
4571 BitmapClass:TBitmapClass;
4572
4573Begin
4574 IconClass:=TIcon;
4575 Asm
4576 MOV EAX,IconClass
4577 MOV Forms.IconClass,EAX
4578 End;
4579 BitmapClass:=TBitmap;
4580 Asm
4581 MOV EAX,BitmapClass
4582 MOV Forms.BitmapClass,EAX
4583 End;
4584End.
4585
4586
Note: See TracBrowser for help on using the repository browser.