Context Navigation

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

Rev	Line
[7]	1	{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
	2	º º
	3	º Sibyl Portable Component Classes º
	4	º º
	5	º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
	6	º º
	7	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
	8
	9	Unit Graphics;
	10
	11	Interface
	12
	13	{$IFDEF OS2}
	14	Uses PmWin,PmGpi,PmBitmap,PmDev,Os2Def,BseDos;
	15	{$ENDIF}
	16
	17	{$IFDEF Win95}
	18	Uses WinNt,WinDef,WinGDI,WinUser,WinBase;
	19	{$ENDIF}
	20
	21	Uses Dos,SysUtils,Classes,Forms;
	22
	23
	24	Type
	25	EInvalidBitmap=Class(Exception);
	26	EInvalidIcon=Class(Exception);
	27	EInvalidCursor=Class(Exception);
	28	EInvalidPictureFormat=Class(Exception);
	29
	30	Type
	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
	359	Implementation
	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
	377	Procedure TBitmapCanvas.CreateHandle;
	378	Begin
	379	If FBitmap<>Nil Then FBitmap.CreateHandle;
	380	End;
	381
	382	Procedure TBitmapCanvas.DestroyHandle;
	383	Begin
	384	If FBitmap<>Nil Then FBitmap.DestroyHandle;
	385	End;
	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
	401	Procedure TBitmap.CreateHandle;
	402	Begin
	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}
	430	End;
	431
	432	Procedure TBitmap.DestroyHandle;
	433	Begin
	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}
	451	End;
	452
	453	Procedure TBitmap.DrawBitmapBits(SrcRec: TRect;Canvas: TCanvas;DstRec: TRect);
	454	{$IFDEF OS2}
	455	Var
	456	DC: HDC;
	457	PS: HPS;
	458	BM: HBITMAP;
	459	Size: SIZEL;
	460	Points: array[0..1] of TRect;
	461	{$ENDIF}
	462	Begin
	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}
	502	End;
	503
	504	{$HINTS OFF}
	505	Function TBitmap.CreateMask( Color:TColor ):TGraphic;
	506	{$IFDEF OS2}
	507	Var Mask: TBitmap;
	508	X,Y: longint;
	509	{$ENDIF}
	510	Begin
	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}
	525	End;
	526	{$HINTS ON}
	527
	528	Function TBitmap.CreateAutoMask:TBitmap;
	529	Begin
	530	Result := TBitmap( CreateMask( Canvas.Pixels[ 0, 0 ] ) );
	531	End;
	532
	533	Function TBitmap.CopyMasked( Mask:TBitmap ):TBitmap;
	534	Var
	535	aRect: TRect;
	536	Begin
	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
	546	End;
	547
	548	Procedure TBitmap.DrawMasked( DestCanvas: TCanvas;
	549	Mask: TBitmap;
	550	SrcRect: TRect;
	551	X,Y: longint );
	552	Var
	553	DestRect: TRect;
	554	OldBrushColor: TColor;
	555	OldPenColor: TColor;
	556	Begin
	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
	590	End;
	591
	592	Procedure TBitmap.DrawMaskedDisabled( DestCanvas: TCanvas;
	593	Mask: TBitmap;
	594	SrcRect: TRect;
	595	X,Y: longint );
	596	Var
	597	DestRect: TRect;
	598	OldBrushColor: TColor;
	599	OldPenColor: TColor;
	600	OldBrushStyle: TBrushStyle;
	601	Begin
	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;
	640	End;
	641
	642	Var LastcbInfo:LongWord;
	643
	644	Procedure TBitmap.LoadFromHandle(AHandle:LongWord);
	645	Var
	646	TheBitmapMem:^LongInt;
	647	TheBitmapMemLength:LongInt;
	648	{$IFDEF OS2}
	649	Var
	650	hdcDst:LongInt;
	651	hpsDst:LongInt;
	652	bmpTemp:BITMAPINFOHEADER2;
	653	sizl:SIZEL;
	654	HPS:LongWord;
	655	rclTemp:TRect;
	656	ptlDst:POINTL;
	657	Label ex;
	658	{$ENDIF}
	659	{$IFDEF Win95}
	660	Var
	661	BI:BitmapCoreInfo;
	662	pbi:^BitmapCoreInfo;
	663	P,pp:Pointer;
	664	cbInfo,cbBuffer:LongWord;
	665	BI2:BitmapInfo;
	666	ADC,MemDC:LongWord;
	667	{$ENDIF}
	668	Begin
	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;
	731	ex:
	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	4BI2.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;
	790	End;
	791
	792	Function TBitmap.LoadFromClipBoard:Boolean;
	793	Var hbmClipbrd:LongWord;
	794	Begin
	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;
	810	End;
	811
	812	Procedure TBitmap.Assign(Source:TPersistent);
	813	Begin
	814	If Source Is TBitmap Then LoadFromBitmap(TBitmap(Source))
	815	Else Inherited Assign(Source);
	816	End;
	817
	818	Procedure TBitmap.CopyToClipboard(Const Src:TRect);
	819	{$IFDEF OS2}
	820	Var 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}
	830	Var
	831	hbmClipBrd,Temp:HBITMAP;
	832	ScreenDC:HDC;
	833	hdcDst,hdcSrc:HDC;
	834	{$ENDIF}
	835	Begin
	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;
	924	End;
	925
	926	Procedure TBitmap.SetupComponent;
	927	Begin
	928	Inherited SetupComponent;
	929
	930	Name:='Bitmap';
	931	FEmpty:=True;
	932	FBitmapHandle:=0;
	933	FBitmapPS:=0;
	934	FBitmapDC:=0;
	935	End;
	936
	937	Procedure TBitmap.changed;
	938	Begin
	939	Inherited changed;
	940	If Owner Is TControl Then TControl(Owner).Invalidate;
	941	End;
	942
	943	Procedure TBitmap.PaletteChanged;
	944	Begin
	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;
	952	End;
	953
	954	Procedure TBitmap.ReleaseBitmap;
	955	Begin
	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;
	990	End;
	991
	992	Procedure TBitmap.ReleaseMemoryCopy; // releases the in-memory copy of the bitmap.
	993	begin
	994	If FBitmapMemLength<>0 Then
	995	If FBitmapMem<>Nil Then
	996	Begin
	997	FreeMem(FBitmapMem,FBitmapMemLength);
	998	FBitmapMem:=Nil;
	999	FBitmapMemLength:=0;
	1000	End;
	1001	end;
	1002
	1003	Destructor TBitmap.Destroy;
	1004	Begin
	1005	ReleaseBitmap;
	1006
	1007	Inherited Destroy;
	1008	End;
	1009
	1010	Function TBitmap.GetHandle:LongWord;
	1011	Begin
	1012	If FBitmapHandle=0 Then If FBitmapMem<>Nil Then SetupBitmap;
	1013	Result:=FBitmapHandle;
	1014	End;
	1015
	1016	Function TBitmap.GetSize;
	1017	Begin
	1018	Result:=FBitmapMemLength;
	1019	End;
	1020
	1021	Function TBitmap.GetCanvas:TCanvas;
	1022	Begin
	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;
	1042	End;
	1043
	1044	Procedure TBitmap.DrawDisabled(Canvas:TCanvas;Const Dest:TRect);
	1045	Var OldLineWidth:LongInt;
	1046	OldLineType:TPenStyle;
	1047	OldBkMode:TBrushMode;
	1048	OldColor:TColor;
	1049	X:LongInt;
	1050	{$IFDEF Win95}
	1051	OldPal:LongWord;
	1052	{$ENDIF}
	1053	Begin
	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}
	1097	End;
	1098
	1099
	1100	Procedure TBitmap.Draw(Canvas:TCanvas;Const Dest:TRect);
	1101	Var {$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}
	1109	Begin
	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}
	1157	End;
	1158
	1159
	1160	Procedure TBitmap.PartialDraw(Canvas:TCanvas;Const Src,Dest:TRect);
	1161	Var {$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}
	1175	Begin
	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}
	1215	End;
	1216
	1217	Function TBitmap.GetEmpty:Boolean;
	1218	Begin
	1219	GetEmpty:=FEmpty;
	1220	End;
	1221
	1222	Function TBitmap.GetHeight:LongInt;
	1223	Begin
	1224	GetHeight:=FHeight;
	1225	End;
	1226
	1227	Procedure TBitmap.SetHeight(NewHeight:LongInt);
	1228	Begin
	1229	FHeight:=NewHeight;
	1230	End;
	1231
	1232	Function TBitmap.GetWidth:LongInt;
	1233	Begin
	1234	GetWidth:=FWidth;
	1235	End;
	1236
	1237	Procedure TBitmap.SetWidth(NewWidth:LongInt);
	1238	Begin
	1239	FWidth:=NewWidth;
	1240	End;
	1241
	1242
	1243	Procedure TBitmap.LoadFromBitmap(Bitmap:TBitmap);
	1244	Begin
	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	{
	1255	evtll 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);
	1265	End;
	1266
	1267
	1268	Function TBitmap.Copy:TBitmap;
	1269	Var locClass:TBitmapClass;
	1270	Begin
	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);
	1279	End;
	1280
	1281	Function TBitmap.CopyGraphic:TGraphic;
	1282	Begin
	1283	Result:=Self.Copy
	1284	End;
	1285
	1286	{$IFDEF OS2}
	1287	{$HINTS OFF}
	1288	Procedure TBitmap.RealizePalette(Canvas:TCanvas);
	1289	Begin
	1290	End;
	1291	{$HINTS ON}
	1292
	1293	Procedure TBitmap.SetupBitmapColors(Header:Pointer;Mask:Boolean);
	1294	Type MyPRGB2=^PMyRGB2;
	1295	PMyRGB2=Array[0..0] Of RGB2;
	1296	Var
	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;
	1305	Begin
	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));
	1404	End;
	1405	{$ENDIF}
	1406
	1407	{$IFDEF Win95}
	1408	Procedure TBitmap.RealizePalette(Canvas:TCanvas);
	1409	Begin
	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;
	1424	End;
	1425
	1426	Procedure TBitmap.SetupBitmapColors(Header:Pointer;Mask:Boolean);
	1427	Var 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;
	1440	Label Win;
	1441	Begin
	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);
	1506	Win:
	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;
	1600	End;
	1601	{$ENDIF}
	1602
	1603	// Turn a specified set of data into an OS bitmap
	1604	{$HINTS OFF}
	1605	Procedure TBitmap.NewImage(BitmapData:Pointer;BitmapSize,OffsBits:LongWord;Mask:Boolean);
	1606	{$IFDEF OS2}
	1607	Var
	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}
	1622	Var
	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}
	1636	Begin
	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:=((((FWidthPBC^.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:=((((FWidthPBC^.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.biBitCountBitmapInfo1^.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.biBitCountBitmapInfo1^.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}
	1993	End;
	1994	{$HINTS ON}
	1995
	1996	Procedure TBitmap.InvalidImage;
	1997	Begin
	1998	FIsInvalid:=True;
	1999	ReleaseBitmap;
	2000	Raise EInvalidBitmap.Create(LoadNLSStr(SInvalidBitmap));
	2001	End;
	2002
	2003	Type
	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
	2015	Type 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
	2025	Procedure TBitmap.SetupBitmap;
	2026	{$IFDEF OS2}
	2027	Var
	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;
	2040	Label LL;
	2041	{$ENDIF}
	2042	{$IFDEF Win95}
	2043	Var
	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;
	2056	Const
	2057	BFT_COLORICON =$4943; { 'CI' }
	2058	BFT_COLORPOINTER =$5043; { 'CP' }
	2059	BFT_BITMAP =$4d42; { 'BM' }
	2060	Label check,ProcessIcon;
	2061	{$ENDIF}
	2062	Begin
	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 Hhe (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^.cPlanespbih^.cBitCount) Do J := 2J;
	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^.cPlanespbih2^.cBitCount) Do J := 2J;
	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
	2140	LL:
	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;
	2200	check:
	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;
	2241	ProcessIcon:
	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^.bcPlanesPBC^.bcBitCount) Do J := 2J;
	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}
	2345	End;
	2346
	2347	Procedure TBitmap.LoadFromResourceId(Id:LongWord);
	2348	Var pbBuffer:Pointer;
	2349	Size:LongWord;
	2350	{$IFDEF Win95}
	2351	C:cstring;
	2352	ResHandle:LongWord;
	2353	{$ENDIF}
	2354	Begin
	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}
	2397	End;
	2398
	2399	Procedure TBitmap.LoadFromResourceName(Const Name:String);
	2400	Var P:Pointer;
	2401	len:LongWord;
	2402	Begin
	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}
	2417	End;
	2418
	2419	Procedure TBitmap.LoadFromMem (Var Buf;Size:LongInt);
	2420	Begin
	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}
	2432	End;
	2433
	2434	Procedure TBitmap.ReadStream(Stream:TStream;Size:LongInt);
	2435	{$IFDEF Win95}
	2436	Var PBmf:^BITMAPFILEHEADER;
	2437	P,p1:Pointer;
	2438	{$ENDIF}
	2439	Begin
	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;
	2472	End;
	2473
	2474	Procedure TBitmap.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
	2475	Begin
	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);
	2496	End;
	2497
	2498	Function TBitmap.WriteSCUResourceName(Stream:TResourceStream;
	2499	ResName:TResourceName):Boolean;
	2500	Begin
	2501	If (FBitmapMemLength>0) And (FBitmapMem<>Nil) Then
	2502	Begin
	2503	Result:=Stream.NewResourceEntry(ResName,FBitmapMem^,FBitmapMemLength);
	2504	End
	2505	Else Result:=True;
	2506	End;
	2507
	2508	Function TBitmap.WriteSCUResource(Stream:TResourceStream):Boolean;
	2509	Begin
	2510	Result := WriteSCUResourceName(Stream,rnBitmap);
	2511	End;
	2512
	2513	Procedure TBitmap.LoadFromStream(Stream:TStream);
	2514	Begin
	2515	FIsInvalid:=False; //reset flag !
	2516	ReadStream(Stream,Stream.Size-Stream.Position);
	2517	changed;
	2518	End;
	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
	2526	Procedure TBitmap.Update;
	2527	{$IFDEF OS2}
	2528	Var
	2529	PaletteSize: longint;
	2530	BitsSize: longint;
	2531	InfoHeader: BITMAPINFOHEADER;
	2532	pInfoHeader: PBITMAPINFOHEADER;
	2533	pFileHeader: ^BITMAPFILEHEADER;
	2534	pBitmapBits: pbyte;
	2535	{$ENDIF}
	2536	{$IFDEF Win95}
	2537	Var
	2538	BI:BitmapCoreInfo;
	2539	pbi:^BitmapCoreInfo;
	2540	P,pp:Pointer;
	2541	cbInfo,cbBuffer:LongWord;
	2542
	2543	BI2:BitmapInfo;
	2544	{$ENDIF}
	2545	Begin
	2546	{$IFDEF OS2}
	2547	//fr PM 2.X format Bitmap2 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.cBitCountInfoHeader.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	4BI2.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}
	2644	End;
	2645
	2646	Procedure TBitmap.SaveToStream(Stream:TStream);
	2647	{$IFDEF Win95}
	2648	Var FH:BITMAPFILEHEADER;
	2649	Const BFT_BMAP =$4D42; { 'BM' }
	2650	{$ENDIF}
	2651	Begin
	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}
	2691	End;
	2692
	2693	{$IFDEF OS2}
	2694	Procedure TBitmap.CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);
	2695	Var
	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;
	2709	Begin
	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;
	2822	End;
	2823	{$ENDIF}
	2824
	2825	Function TBitmap.IsEqual(Bitmap:TBitmap):Boolean;
	2826	Begin
	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;
	2835	End;
	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
	2851	Procedure TIcon.SetupComponent;
	2852	Begin
	2853	Inherited SetupComponent;
	2854
	2855	Name:='Icon';
	2856	End;
	2857
	2858	Function TIcon.GetMaskCanvas:TCanvas;
	2859	Begin
	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;
	2879	End;
	2880
	2881
	2882	Procedure TIcon.CreateHandle;
	2883	Begin
	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}
	2908	End;
	2909
	2910
	2911	Procedure TIcon.DestroyHandle;
	2912	Begin
	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}
	2933	End;
	2934
	2935
	2936	Procedure TIcon.InvalidImage;
	2937	Begin
	2938	FIsInvalid:=True;
	2939	ReleaseBitmap;
	2940	Raise EInvalidIcon.Create(LoadNLSStr(SInvalidIcon));
	2941	End;
	2942
	2943	Function TIcon.GetHandle:LongWord;
	2944	Begin
	2945	Result:=FIconPointerHandle;
	2946	End;
	2947
	2948	Procedure TIcon.SetupBitmap;
	2949	Begin
	2950	Inherited SetupBitmap;
	2951
	2952	CreateIconPointerHandle;
	2953
	2954	If FMaskCanvas=Nil Then FMaskCanvas.Create(Self);
	2955	FMaskCanvas.Handle:=FMaskPS;
	2956	FMaskCanvas.Init;
	2957	CreateHandle;
	2958	End;
	2959
	2960	Procedure TIcon.Draw(Canvas:TCanvas;Const Dest:TRect);
	2961	{$IFDEF OS2}
	2962	Var ptls,maskptls:Array[0..3] Of TPoint;
	2963	{$ENDIF}
	2964	{$IFDEF Win95}
	2965	Var _Dest:TRect;
	2966	OldPal:LongWord;
	2967	{$ENDIF}
	2968	Begin
	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}
	3044	End;
	3045
	3046	Procedure TIcon.ReleaseBitmap;
	3047	Begin
	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;
	3080	End;
	3081
	3082	Procedure TIcon.CreateIconPointerHandle;
	3083	{$IFDEF OS2}
	3084	Var I:POINTERINFO;
	3085	{$ENDIF}
	3086	{$IFDEF Win95}
	3087	Var I:ICONINFO;
	3088	ADC,MemDC:HDC;
	3089	H,OldBmp:LongWord;
	3090	{$ENDIF}
	3091	Begin
	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}
	3141	End;
	3142
	3143	Procedure TIcon.Update;
	3144	{$IFDEF OS2}
	3145	Var
	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}
	3155	Var
	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}
	3163	Begin
	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.cBitCountBIHMask.CX)+31) Div 32)4BIHMask.CYBIHMask.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.cBitCountBIH.CX)+31) Div 32)4BIH.CYBIH.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	4BI.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	4BI.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}
	3313	End;
	3314
	3315
	3316	Procedure TIcon.LoadFromResourceName(Const Name:String);
	3317	Var P:Pointer;
	3318	len:LongWord;
	3319	Begin
	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}
	3334	End;
	3335
	3336	Procedure TIcon.CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);
	3337	{$IFDEF OS2}
	3338	Var dop:DEVOPENSTRUC;
	3339	pc:cstring;
	3340	sizl:SIZEL;
	3341	BIH:BITMAPINFOHEADER;
	3342	ps,DC:LongWord;
	3343	ptls:Array[0..3] Of TPoint;
	3344	{$ENDIF}
	3345	Begin
	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;
	3421	End;
	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
	3438	Procedure TPointer.InvalidImage;
	3439	Begin
	3440	FIsInvalid:=True;
	3441	ReleaseBitmap;
	3442	Raise EInvalidCursor.Create(LoadNLSStr(SInvalidCursor));
	3443	End;
	3444
	3445	Procedure TPointer.SetupComponent;
	3446	Begin
	3447	Inherited SetupComponent;
	3448
	3449	Name:='Pointer';
	3450	End;
	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
	3466	Function TBitmapList.CopyBitmap(original:TBitmap):TBitmap;
	3467	Var locClass:TBitmapClass;
	3468	Begin
	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;
	3483	End;
	3484
	3485
	3486	Function TBitmapList.GetBitmap(Index:LongInt):TBitmap;
	3487	Begin
	3488	Result := Items[Index];
	3489	End;
	3490
	3491
	3492	Procedure TBitmapList.SetBitmap(Index:LongInt;Bitmap:TBitmap);
	3493	Var Item:TBitmap;
	3494	Begin
	3495	Item := Items[Index];
	3496	FreeItem(Item);
	3497	Items[Index] := CopyBitmap(Bitmap);
	3498	End;
	3499
	3500
	3501	Procedure TBitmapList.FreeItem(Item:Pointer);
	3502	Var bmp:TBitmap;
	3503	Begin
	3504	{Destroy local Bitmap}
	3505	bmp := Item;
	3506	If bmp Is TBitmap Then bmp.Destroy;
	3507	End;
	3508
	3509
	3510	Function TBitmapList.Add(Item:TBitmap):LongInt;
	3511	Begin
	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));
	3519	End;
	3520
	3521
	3522	Function TBitmapList.AddResourceId(BmpId:LongWord):LongInt;
	3523	Var bmp:TBitmap;
	3524	Begin
	3525	bmp.Create;
	3526	bmp.LoadFromResourceId(BmpId);
	3527	Result := Add(bmp); {creates A local Copy}
	3528	bmp.Destroy; {#}
	3529	End;
	3530
	3531
	3532	Function TBitmapList.AddResourceName(Const Name:String):LongInt;
	3533	Var bmp:TBitmap;
	3534	Begin
	3535	bmp.Create;
	3536	bmp.LoadFromResourceName(Name);
	3537	Result := Add(bmp); {creates A local Copy}
	3538	bmp.Destroy; {#}
	3539	End;
	3540
	3541
	3542	Procedure TBitmapList.Insert(Index:LongInt;Item:TBitmap);
	3543	Begin
	3544	TList.Insert(Index,CopyBitmap(Item));
	3545	End;
	3546
	3547
	3548	Function TBitmapList.IndexOfOrigin(Item:TBitmap):LongInt;
	3549	Var locBitmap:TBitmap;
	3550	Begin
	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;
	3558	End;
	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
	3575	Function TImageList.NewItem:PImageItem;
	3576	Begin
	3577	New(Result);
	3578	End;
	3579
	3580	Function TImageList.Add(Image,Mask:TBitmap):LongInt;
	3581	Var Item:PImageItem;
	3582	Begin
	3583	Item:=NewItem;
	3584	Item^.Bitmap:=Image.Copy;
	3585	If Mask<>Nil Then Item^.Mask:=Mask.Copy;
	3586	Result:=FList.Add(Item);
	3587	Change;
	3588	End;
	3589
	3590	Function TImageList.AddIcon(Image:TIcon):LongInt;
	3591	Var Item:PImageItem;
	3592	Begin
	3593	Item:=NewItem;
	3594	Item^.Icon:=TIcon(Image.Copy);
	3595	Result:=FList.Add(Item);
	3596	Change;
	3597	End;
	3598
	3599	Procedure TImageList.AddImages(Value:TImageList);
	3600	Var t:LongInt;
	3601	Item,Item1:PImageItem;
	3602	Begin
	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;
	3614	End;
	3615
	3616	Procedure TImageList.Initialize;
	3617	Begin
	3618	FImageType:=itImage;
	3619	FMasked:=False;
	3620
	3621	FList.Create;
	3622	FList.ImageList:=Self;
	3623	End;
	3624
	3625	Procedure TImageList.SetupComponent;
	3626	Begin
	3627	Inherited SetupComponent;
	3628	Name:='ImageList';
	3629
	3630	Include(ComponentState, csHandleLinks);
	3631	Initialize;
	3632	End;
	3633
	3634	Procedure TImageList.DisposeItem(Item:PImageItem);
	3635	Begin
	3636	Dispose(Item);
	3637	End;
	3638
	3639	Procedure TImageList.Clear;
	3640	Var t:LongInt;
	3641	Item:PImageItem;
	3642	Begin
	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;
	3653	End;
	3654
	3655	Destructor TImageList.Destroy;
	3656	Begin
	3657	Clear;
	3658	FList.Destroy;
	3659	Inherited Destroy;
	3660	End;
	3661
	3662	Procedure TImageList.Change;
	3663	Begin
	3664	If FOnChange<>Nil Then FOnChange(Self);
	3665	End;
	3666
	3667	Function TImageList.GetCount:LongInt;
	3668	Begin
	3669	Result:=FList.Count;
	3670	End;
	3671
	3672	Procedure TImageList.Delete(Index:LongInt);
	3673	Var Item:PImageItem;
	3674	Begin
	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);
	3681	End;
	3682
	3683	Procedure TImageList.Replace(Index:LongInt;Image,Mask:TBitmap);
	3684	Var Item:PImageItem;
	3685	Begin
	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;
	3692	End;
	3693
	3694	Procedure TImageList.ReplaceIcon(Index:LongInt;Image:TIcon);
	3695	Var Item:PImageItem;
	3696	Begin
	3697	Item:=FList[Index];
	3698	If Item^.Icon<>Nil Then Item^.Icon.Destroy;
	3699	Item^.Icon:=TIcon(Image.Copy);
	3700	End;
	3701
	3702	Procedure TImageList.Insert(Index:LongInt;Image,Mask:TBitmap);
	3703	Var Item:PImageItem;
	3704	Begin
	3705	Item:=NewItem;
	3706	Item^.Bitmap:=Image.Copy;
	3707	If Mask<>Nil Then Item^.Mask:=Mask.Copy;
	3708	FList.Insert(Index,Item);
	3709	End;
	3710
	3711	Procedure TImageList.InsertIcon(Index:LongInt;Image:TIcon);
	3712	Var Item:PImageItem;
	3713	Begin
	3714	Item:=NewItem;
	3715	Item^.Icon:=TIcon(Image.Copy);
	3716	FList.Insert(Index,Item);
	3717	End;
	3718
	3719	Procedure TImageList.GetBitmap(Index:LongInt;Image:TBitmap);
	3720	Begin
	3721	Image.LoadFromBitmap(PImageItem(FList[Index])^.Bitmap);
	3722	End;
	3723
	3724	Function TImageList.GetBitmapReference( Index:LongInt ): TBitmap;
	3725	Begin
	3726	Result := PImageItem( FList[ Index ] )^.Bitmap;
	3727	End;
	3728
	3729	Procedure TImageList.GetIcon(Index: Integer;Icon:TIcon);
	3730	Begin
	3731	Icon.LoadFromBitmap(PImageItem(FList[Index])^.Icon);
	3732	End;
	3733
	3734	Procedure TImageList.GetMask(Index:LongInt;Mask:TBitmap);
	3735	Begin
	3736	Mask.LoadFromBitmap(PImageItem(FList[Index])^.Mask);
	3737	End;
	3738
	3739	Procedure TImageList.Move(CurIndex,NewIndex:LongInt);
	3740	Begin
	3741	FList.Move(CurIndex,NewIndex);
	3742	End;
	3743
	3744	Procedure TImageList.Draw(Canvas:TCanvas;X,Y,Index:LongInt);
	3745	Var Bitmap,Mask:TBitmap;
	3746	Source,Dest:TRect;
	3747	Begin
	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;
	3805	End;
	3806
	3807	Procedure TImageList.SetList(Item:TImageItemList);
	3808	Begin
	3809	If Item<>Nil Then If FList<>Item Then
	3810	Begin
	3811	FList.Destroy;
	3812	FList:=Item;
	3813	End;
	3814	End;
	3815
	3816	Procedure TImageList.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
	3817	Var 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
	3838	Begin
	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);
	3856	End;
	3857
	3858	Function TImageList.WriteSCUResource(Stream:TResourceStream):Boolean;
	3859	Var 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
	3883	Begin
	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;
	3912	End;
	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
	3929	Constructor TMetaFileCanvas.Create(AMetafile: TMetafile);
	3930	{$IFDEF OS2}
	3931	Var sizlPage:SIZEL;
	3932	{$ENDIF}
	3933	Begin
	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;
	3948	End;
	3949
	3950	Destructor TMetaFileCanvas.Destroy;
	3951	Begin
	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;
	3961	End;
	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
	3977	Function TMetaFile.GetEmpty: Boolean;
	3978	Begin
	3979	//not implemented yet
	3980	Result:=False;
	3981	End;
	3982
	3983	const
	3984	co : longword = 22;
	3985
	3986	Function TMetaFile.GetHeight:LongInt;
	3987	var
	3988	Size : PSIZEL;
	3989	P : Pointer;
	3990	len : longint;
	3991	Begin
	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
	4000	End;
	4001
	4002	Function TMetaFile.GetWidth:LongInt;
	4003	var
	4004	Size : PSIZEL;
	4005	P : Pointer;
	4006	len : longint;
	4007	Begin
	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
	4016	End;
	4017
	4018	Procedure TMetaFile.Assign(Source:TPersistent);
	4019	Begin
	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);
	4033	End;
	4034
	4035	(*
	4036
	4037	alOpt[PMF_SEGBASE] = 0; /* Reserved */
	4038	alOpt[PMF_LOADTYPE] = LT_DEFAULT; /* Default transformations */
	4039	alOpt[PMF_RESOLVE] = 0; /* Reserved */
	4040	alOpt[PMF_LCIDS] = LC_DEFAULT; /* Uses default lcids */
	4041	alOpt[PMF_RESET] = RES_DEFAULT; /* Uses default */
	4042	alOpt[PMF_SUPPRESS] = SUP_DEFAULT; /* Uses default */
	4043	alOpt[PMF_COLORTABLES] = CTAB_DEFAULT; /* Uses default */
	4044	alOpt[PMF_COLORREALIZABLE] = CREA_DEFAULT; /* Uses default */
	4045
	4046	GpiPlayMetaFile(hps, /* Plays metafile onto screen */
	4047	hmf, 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
	4056	Procedure TMetaFile.GetOriginalRect(Var Rect: RECTL);
	4057	{$IFDEF OS2}
	4058	Var 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}
	4068	Begin
	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}
	4101	End;
	4102	{$HINTS ON}
	4103
	4104	Procedure TMetaFile.Draw(ACanvas: TCanvas;Const Rect: TRect);
	4105	{$IFDEF OS2}
	4106	Var alOpt:Array[0..8] Of LongInt;
	4107	L : Long;
	4108	xyRect : RECTL;
	4109	Boundary: RECTL;
	4110	Size : SIZEL;
	4111	flOptions : ULONG;
	4112	{$ENDIF}
	4113	Begin
	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}
	4199	End;
	4200	{$HINTS ON}
	4201
	4202	{$HINTS OFF}
	4203	Procedure TMetaFile.SetHeight(Value:LongInt);
	4204	Begin
	4205	//not implemented yet
	4206	//FHeight := Value;
	4207	End;
	4208
	4209	Procedure TMetaFile.SetWidth(Value:LongInt);
	4210	Begin
	4211	//not implemented yet
	4212	//FWidth := Value;
	4213	End;
	4214	{$HINTS ON}
	4215
	4216	Procedure TMetaFile.SetupComponent;
	4217	{$IFDEF OS2}
	4218	Var dop:DEVOPENSTRUC;
	4219	pc:CString;
	4220	{$ENDIF}
	4221	Begin
	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}
	4230	End;
	4231
	4232	Destructor TMetaFile.Destroy;
	4233	Begin
	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}
	4241	End;
	4242
	4243	Function TMetaFile.GetHandle:LongWord;
	4244	Begin
	4245	Result:=FHandle;
	4246	End;
	4247
	4248	Procedure TMetaFile.LoadFromFile(Const FileName:String);
	4249	Begin
	4250	{$IFDEF OS2}
	4251	FHandle:=GpiLoadMetaFile(AppHandle,FileName);
	4252	{$ENDIF}
	4253	End;
	4254
	4255	Procedure TMetaFile.SaveToFile(Const Filename: String);
	4256	Begin
	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}
	4266	End;
	4267
	4268	Procedure TMetaFile.LoadFromStream(Stream: TStream);
	4269	Var p:Pointer;
	4270	Len:LongInt;
	4271	Begin
	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}
	4285	End;
	4286
	4287	Procedure TMetaFile.SaveToStream(Stream: TStream);
	4288	Var p:Pointer;
	4289	Len:LongInt;
	4290	Begin
	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}
	4304	End;
	4305
	4306	Function TMetaFile.CopyGraphic:TGraphic;
	4307	Begin
	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}
	4318	End;
	4319
	4320	Procedure TMetaFile.LoadFromHandle(Handle:LongWord);
	4321	Begin
	4322	{$IFDEF OS2}
	4323	If FHandle<>0 Then GpiDeleteMetaFile(FHandle);
	4324	FHandle:=GpiCopyMetaFile(Handle);
	4325	{$ENDIF}
	4326	End;
	4327
	4328	{Martin}
	4329	Function TMetaFile.LoadFromClipBoard:Boolean;
	4330	Var hbmClipbrd:LongWord;
	4331	Begin
	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
	4351	End;
	4352
	4353
	4354
	4355	Function TMetaFile.GetCanvas:TCanvas;
	4356	Begin
	4357	Result:=TCanvas(FMetaFileCanvas);
	4358	End;
	4359
	4360	Function TMetaFile.GetSize:LongInt;
	4361	Begin
	4362	{$IFDEF OS2}
	4363	If FHandle<>0 Then Result:=GpiQueryMetaFileLength(FHandle)
	4364	Else Result:=0;
	4365	{$ENDIF}
	4366	End;
	4367
	4368	{$HINTS OFF}
	4369	Procedure TMetaFile.PaletteChanged;
	4370	Begin
	4371	//not implemented yet
	4372	End;
	4373	{$HINTS ON}
	4374
	4375	{$HINTS OFF}
	4376	Procedure TMetaFile.CreateNew(NewWidth,NewHeight:LongWord;Colors:LongWord);
	4377	{$IFDEF OS2}
	4378	Var dop:DEVOPENSTRUC;
	4379	pc:CString;
	4380	{$ENDIF}
	4381	Begin
	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}
	4393	End;
	4394	{$HINTS ON}
	4395
	4396	{$HINTS OFF}
	4397	Function TMetaFile.CreateMask(Color:TColor):TGraphic;
	4398	Begin
	4399	//not supported yet
	4400	Result:=Nil;
	4401	End;
	4402	{$HINTS ON}
	4403
	4404	{$HINTS OFF}
	4405	Procedure TMetaFile.PartialDraw(Canvas:TCanvas;Const Src,Dest:TRect);
	4406	Begin
	4407	//not supported yet
	4408	End;
	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
	4425	Function TPicture.GetBitmap:TBitmap;
	4426	Begin
	4427	ForceType(TBitmap);
	4428	Result:=TBitmap(FGraphic);
	4429	End;
	4430
	4431	Function TPicture.GetEmpty:Boolean;
	4432	Begin
	4433	Result:=FGraphic=Nil;
	4434	End;
	4435
	4436	Function TPicture.HasFormat(GraphicClass:TGraphicClass):Boolean;
	4437	Begin
	4438	Result:=FGraphic Is GraphicClass;
	4439	End;
	4440
	4441	Function TPicture.GetHeight:LongInt;
	4442	Begin
	4443	If FGraphic<>Nil Then Result:=FGraphic.Height
	4444	Else Result:=0;
	4445	End;
	4446
	4447	Procedure TPicture.AssignTo(Dest:TPersistent);
	4448	Begin
	4449	If FGraphic Is Dest.ClassType Then Dest.Assign(FGraphic)
	4450	Else Inherited AssignTo(Dest);
	4451	End;
	4452
	4453	Procedure TPicture.Assign(Source:TPersistent);
	4454	Begin
	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);
	4459	End;
	4460
	4461	Function TPicture.GetIcon:TIcon;
	4462	Begin
	4463	ForceType(TIcon);
	4464	Result:=TIcon(FGraphic);
	4465	End;
	4466
	4467	Function TPicture.GetMetafile:TMetafile;
	4468	Begin
	4469	ForceType(TMetaFile);
	4470	Result:=TMetaFile(FGraphic);
	4471	End;
	4472
	4473	Function TPicture.GetWidth:LongInt;
	4474	Begin
	4475	If FGraphic<>Nil Then Result:=FGraphic.Width
	4476	Else Result:=0;
	4477	End;
	4478
	4479	Procedure TPicture.SetBitmap(Value: TBitmap);
	4480	Begin
	4481	SetGraphic(Value);
	4482	End;
	4483
	4484	Procedure TPicture.SetIcon(Value: TIcon);
	4485	Begin
	4486	SetGraphic(Value);
	4487	End;
	4488
	4489	Procedure TPicture.SetMetafile(Value: TMetafile);
	4490	Begin
	4491	SetGraphic(Value);
	4492	End;
	4493
	4494	Procedure TPicture.SetGraphic(Value: TGraphic);
	4495	Var NewGraphic:TGraphic;
	4496	Begin
	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;
	4511	End;
	4512
	4513	Procedure TPicture.Changed(Sender: TObject);
	4514	Begin
	4515	If FOnChange<>Nil Then FOnChange(Self);
	4516	End;
	4517
	4518
	4519	Destructor TPicture.Destroy;
	4520	Begin
	4521	If FGraphic<>Nil Then FGraphic.Destroy;
	4522	Inherited Destroy;
	4523	End;
	4524
	4525	Procedure TPicture.LoadFromFile(Const Filename:String);
	4526	Var Ext:String;
	4527	aClass:TGraphicClass;
	4528	NewGraphic:TGraphic;
	4529	Begin
	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);
	4545	End;
	4546
	4547
	4548	Procedure TPicture.SaveToFile(Const Filename:String);
	4549	Begin
	4550	If FGraphic<>Nil Then FGraphic.SaveToFile(FileName);
	4551	End;
	4552
	4553
	4554	Procedure TPicture.ForceType(GraphicType:TGraphicClass);
	4555	Begin
	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;
	4563	End;
	4564
	4565
	4566	//unit initalization
	4567
	4568	Type TIconClass=Class Of TIcon;
	4569
	4570	Var IconClass:TIconClass;
	4571	BitmapClass:TBitmapClass;
	4572
	4573	Begin
	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;
	4584	End.
	4585
	4586

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format