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