function CopyPalette( Palette : HPalette ) : HPalette ;var nEntries : integer ;LogPalSize : integer ;LogPalette : PLogPalette ;beginResult := 0 ;if Palette = 0 then exit ;GetObject( Palette, sizeof( nEntries ), @nEntries ) ;if nEntries < 1 then exit ;LogPalSize := sizeof( TLogPalette ) + sizeof( TPaletteEntry ) * ( nEntries - 1 ) ;GetMem( LogPalette, LogPalSize ) ;with LogPalette^ do trypalVersion := $300 ;palNumEntries := nEntries ;GetPaletteEntries( Palette, 0, nEntries, palPalEntry[ 0 ] ) ;Result := CreatePalette( LogPalette^ ) ;finallyFreeMem( LogPalette, LogPalSize ) ;end ;end ; procedure TForm1.Button1Click(Sender: TObject);var Bitmap : TBitmap ;beginBitmap := TBitmap.Create ;tryBitmap.Width := 50 ;Bitmap.Height := 40 ;Bitmap.Palette := CopyPalette( Image1.Picture.Bitmap.Palette ) ;Bitmap.Canvas.CopyRect( Rect( 0, 0, 50, 40 ),Image1.Picture.Bitmap.Canvas,Bounds( 20, 10, 50, 40 ) ) ;Bitmap.SaveToFile( 'c:\windows\temp\junk.bmp' ) ;finallyBitmap.Free ;end ;end; |
- Mike Scott. [000912]