fcBitmap.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:39k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit fcBitmap;
  2. {
  3. //
  4. // Components : TfcBitmap
  5. //
  6. // Copyright (c) 1999 by Woll2Woll Software
  7. // 12/3/99 - Only use DibColor table if it is valid.
  8. //           Previously just checked if colors[0] was 0 for valid determination
  9. // 12/4/99 - Support true color bitmaps in 256 color environments by creating
  10. //           half-tone palette
  11. // 12/7/99 - new method Changecolor used by fcImgBtn
  12. // 11/1/2001 - Use Draw when loading from graphic as this is more generic and allows Graphic to define how it is drawn to the bitmap.
  13. }
  14. interface
  15. {$i fcIfDef.pas}
  16. uses Windows, Graphics, Classes, fcGraphics, fcChangeLink, SysUtils;
  17. type
  18.   TfcColor = record
  19.     b, g, r: Byte
  20.   end;
  21.   PfcColor = ^TfcColor;
  22.   TfcLine = array[0..0] of TfcColor;
  23.   PfcLine = ^TfcLine;
  24.   TfcPLines = array[0..0] of PfcLine;
  25.   PfcPLines = ^TfcPLines;
  26.   TfcBitmap = class(TGraphic)
  27.   private
  28.     FSmoothStretching: Boolean;
  29.     FTransparentColor: TColor;
  30.     FWidth: Integer;
  31.     FHeight: Integer;
  32.     FGap: Integer;
  33.     FMaskBitmap: TBitmap;
  34.     FRowInc: Integer;
  35.     FSize: Integer;
  36.     FBits: Pointer;
  37.     FHandle: Integer;
  38.     FDC: HDC;
  39.     FCanvas: TCanvas;
  40.     FMemoryImage: Pointer;
  41.     FMemorySize: Integer;
  42.     FMemoryDim: TSize;
  43.     FPixelFormat: TPixelFormat;
  44.     FPalette: HPALETTE;
  45.     FRespectPalette: Boolean;
  46.     FUseHalftonePalette: boolean;
  47.     FIgnoreChange: Boolean;
  48.     FChangeLinks: TList;
  49. //    FPicture: TPicture;
  50.     bmInfo: TBitmapInfo;
  51.     bmHeader: TBitmapInfoHeader;
  52.     function GetSleeping: Boolean;
  53.     procedure InitHeader;
  54.   protected
  55.     Assigning: Boolean;
  56.     SkipPalette: boolean;
  57.     Procedure RestoreBitmapPalette(ACanvas: TCanvas; OldPalette: HPalette); virtual;
  58.     Procedure SelectBitmapPalette(ACanvas: TCanvas; var OldPalette: HPalette); virtual;
  59.     function GetEmpty: Boolean; override;
  60.     function GetHeight: Integer; override;
  61.     function GetWidth: Integer; override;
  62.     procedure AssignTo(Dest: TPersistent); override;
  63.     procedure Changed(Sender: TObject); override;
  64.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  65.     procedure SetHeight(Value: Integer); override;
  66.     procedure SetWidth(Value: Integer); override;
  67.     procedure CleanUp; virtual;
  68.     procedure Initialize; virtual;
  69.     procedure NotifyChanges; virtual;
  70.     procedure PaletteNeeded; virtual;
  71.     property Gap: Integer read FGap;
  72.     property RowInc: Integer read FRowInc;
  73.     property DC: HDC read FDC;
  74.   public
  75.     Patch: Variant;
  76.     Pixels: PfcPLines;
  77.     Colors: array[Byte] of TRGBQuad;
  78.     constructor Create; override;
  79.     destructor Destroy; override;
  80.     procedure Assign(Source: TPersistent); override;
  81.     procedure RegisterChanges(ChangeLink: TfcChangeLink); virtual;
  82.     procedure UnRegisterChanges(ChangeLink: TfcChangeLink); virtual;
  83.     procedure Clear; virtual;
  84.     procedure FreeMemoryImage; virtual;
  85.     procedure LoadBlank(AWidth, AHeight: Integer); virtual;
  86.     procedure LoadFromBitmap(Bitmap: TBitmap); virtual;
  87.     procedure LoadFromJPEG(JPEG: TGraphic); virtual;
  88.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  89.       APalette: HPALETTE); override;
  90.     procedure LoadFromGraphic(Graphic: TGraphic); virtual;
  91.     procedure LoadFromMemory(ABits: Pointer; ASize: Integer; Dimensions: TSize); virtual;
  92.     procedure LoadFromStream(Stream: TStream); override;
  93.     procedure SaveToBitmap(Bitmap: TBitmap); virtual;
  94.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  95.       var APalette: HPALETTE); override;
  96.     procedure SaveToStream(Stream: TStream); override;
  97.     procedure SetSize(const AWidth, AHeight: Integer); virtual;
  98.     function GetMaskBitmap: TBitmap;
  99.     function CopyPixels: PfcPLines;
  100.     procedure Fill(Color: TColor);
  101.     procedure Resize(AWidth, AHeight: Integer); virtual;
  102.     procedure Sleep; virtual;
  103.     procedure SmoothStretchDraw(ACanvas: TCanvas; Rect: TRect); virtual;
  104.     procedure StretchDraw(ACanvas: TCanvas; const Rect: TRect); virtual;
  105.     procedure TileDraw(ACanvas: TCanvas; ARect: TRect); virtual;
  106.     procedure TransparentDraw(ACanvas: TCanvas; const Rect: TRect); virtual;
  107.     procedure Wake; virtual;
  108.     // Filters
  109.     procedure AlphaBlend(Bitmap: TfcBitmap; Alpha: Integer; Stretch: Boolean);
  110.     procedure Blur(Amount: Integer); virtual;
  111.     procedure Contrast(Amount: Integer); virtual;
  112.     procedure Emboss; virtual;
  113.     procedure Flip(Horizontal: Boolean); virtual;
  114.     procedure GaussianBlur(Amount: Integer); virtual;
  115.     procedure Grayscale; virtual;
  116.     procedure Invert; virtual;
  117.     procedure Brightness(Amount: Integer); virtual;
  118.     procedure Mask(MaskColor: TfcColor); virtual;
  119.     { 12/7/99 - new method Changecolor used by fcImgBtn }
  120.     procedure ChangeColor(OldColor: TfcColor; NewColor: TfcColor); virtual;
  121.     procedure ColorTint(ra, ga, ba: Integer); virtual;
  122.     procedure Colorize(ra, ga, ba: Integer); virtual;
  123.     procedure Rotate(Center: TPoint; Angle: Extended); virtual;
  124.     procedure Saturation(Amount: Integer); virtual;
  125.     procedure Sharpen(Amount: Integer); virtual;
  126.     procedure Sponge(Amount: Integer); virtual;
  127.     procedure Wave(XDiv, YDiv, RatioVal: Extended; Wrap: Boolean); virtual;
  128.     property Bits: Pointer read FBits;
  129.     property Canvas: TCanvas read FCanvas;
  130.     property Handle: Integer read FHandle;
  131.     property IgnoreChange: Boolean read FIgnoreChange write FIgnoreChange;
  132.     property MaskBitmap: TBitmap read GetMaskBitmap;
  133.     property RespectPalette: Boolean read FRespectPalette write FRespectPalette;
  134.     property UseHalftonePalette: Boolean read FUseHalftonePalette write FUseHalftonePalette;
  135.     property SmoothStretching: Boolean read FSmoothStretching write FSmoothStretching;
  136.     property Sleeping: Boolean read GetSleeping;
  137.     property Size: Integer read FSize;
  138.     property TransparentColor: TColor read FTransparentColor write FTransparentColor;
  139.   end;
  140. function fcGetColor(Color: TColor): TfcColor;
  141. function fcGetStdColor(Color: TfcColor): TColor;
  142. function fcRGB(r, g, b: Byte): TfcColor;
  143. function fcIntToByte(Value: Integer): Byte;
  144. function fcTrimInt(i, Min, Max: Integer): Integer;
  145. implementation
  146. uses
  147. {$ifdef fcdelphi6Up}
  148. variants,
  149. {$endif}
  150.  fcCommon;
  151. {$R-}
  152. function fcGetColor(Color: TColor): TfcColor;
  153. begin
  154.   //2/17/99 - Get Actual Color Value
  155.   Color := ColorToRGB(Color);
  156.   result.r := Color and $FF;
  157.   result.g := Color and $FF00 shr 8;
  158.   result.b := Color and $FF0000 shr 16;
  159. end;
  160. function fcGetStdColor(Color: TfcColor): TColor;
  161. begin
  162.   with Color do result := RGB(r, g, b);
  163. end;
  164. function fcRGB(r, g, b: Byte): TfcColor;
  165. begin
  166.   result.r := r;
  167.   result.g := g;
  168.   result.b := b;
  169. end;
  170. function fcIntToByte(Value: Integer): Byte;
  171. begin
  172.   if Value > 255 then result := 255
  173.   else if Value < 0 then result := 0
  174.   else result := Value;
  175. end;
  176. function fcTrimInt(i, Min, Max: Integer): Integer;
  177. begin
  178.   if i > Max then result := Max
  179.   else if i < Min then result := Min
  180.   else result := i;
  181. end;
  182. constructor TfcBitmap.Create;
  183. begin
  184.   inherited;
  185.   FCanvas := TCanvas.Create;
  186.   FChangeLinks := TList.Create;
  187.   FTransparentColor := clNone;
  188.   FPixelFormat := pf24Bit;
  189.   Patch:= VarArrayCreate([0, 1], varVariant);
  190.   Patch[0]:= False;     { Color table not valid }
  191.   Patch[1]:= False;
  192. end;
  193. destructor TfcBitmap.Destroy;
  194. begin
  195.   FChangeLinks.Free;
  196.   if Sleeping then FreeMemoryImage;
  197.   CleanUp;
  198.   FCanvas.Free;
  199.   inherited;
  200. end;
  201. function TfcBitmap.GetSleeping: Boolean;
  202. begin
  203.   result := (FMemorySize > 0) and (FMemoryImage <> nil);
  204. end;
  205. function TfcBitmap.GetEmpty: Boolean;
  206. begin
  207.   result := FHandle = 0;
  208. end;
  209. function TfcBitmap.GetHeight: Integer;
  210. begin
  211.   result := FHeight;
  212. end;
  213. function TfcBitmap.GetWidth: Integer;
  214. begin
  215.   result := FWidth;
  216. end;
  217. procedure TfcBitmap.Assign(Source: TPersistent);
  218. begin
  219.   if (Source is TBitmap) and not (Source as TBitmap).Empty then
  220.   begin
  221.     FPixelFormat := (Source as TBitmap).PixelFormat;
  222.     LoadFromBitmap(Source as TBitmap);
  223.     Transparent := (Source as TBitmap).Transparent;
  224. //    TransparentColor := (Source as TBitmap).TransparentColor;
  225.   end else if (Source = nil) or ((Source is TBitmap) and (Source as TBitmap).Empty) then
  226.   begin
  227.     CleanUp;
  228.     Changed(self);
  229.   end else if (Source is TGraphic) and not (Source is TfcBitmap) then
  230.   begin
  231.     LoadFromGraphic(Source as TGraphic);
  232.   end else inherited;
  233. end;
  234. procedure TfcBitmap.AssignTo(Dest: TPersistent);
  235. begin
  236.   if Dest is TBitmap then
  237.   begin
  238.     (Dest as TBitmap).PixelFormat := self.FPixelFormat;
  239.     SaveToBitmap(Dest as TBitmap);
  240.     (Dest as TBitmap).Transparent := Transparent;
  241.     (Dest as TBitmap).TransparentColor := TransparentColor;
  242.   end else if Dest is TfcBitmap then
  243.     with TfcBitmap(Dest) do
  244.   begin
  245.     if not self.Empty then
  246.     begin
  247.       IgnoreChange := True;
  248.       RespectPalette := self.RespectPalette;
  249.       UseHalftonePalette:= self.UseHalftonePalette;
  250.       LoadBlank(self.Width, self.Height);
  251.       CopyMemory(TfcBitmap(Dest).Bits, self.Bits, self.Size);
  252.       Transparent := self.Transparent;
  253.       SmoothStretching := self.SmoothStretching;
  254.       TransparentColor := self.TransparentColor;
  255.       FPixelFormat := self.FPixelFormat;
  256.       CopyMemory(@(Dest as TfcBitmap).Colors, @self.Colors, SizeOf(self.Colors));
  257.       Patch[0]:= self.Patch[0];
  258.       Patch[1]:= self.Patch[1]; // Halftone value
  259. //      FHalfTone:= self.FHalfTone;
  260.       IgnoreChange := False;
  261.       Changed(Dest);
  262.     end else begin
  263.       CleanUp;
  264.       Changed(Dest);
  265.     end;
  266.   end else inherited;
  267. end;
  268. procedure TfcBitmap.Changed(Sender: TObject);
  269. begin
  270.   if not IgnoreChange then
  271.   begin
  272.     inherited Changed(Sender);
  273.     NotifyChanges;
  274.   end;
  275. end;
  276. procedure TfcBitmap.NotifyChanges;
  277. var i: Integer;
  278. begin
  279.   for i := 0 to FChangeLinks.Count - 1 do with TfcChangeLink(FChangeLinks[i]) do
  280.   begin
  281.     Sender := self;
  282.     Change;
  283.   end;
  284. end;
  285. procedure TfcBitmap.RegisterChanges(ChangeLink: TfcChangeLink);
  286. begin
  287.   FChangeLinks.Add(ChangeLink);
  288. end;
  289. procedure TfcBitmap.UnRegisterChanges(ChangeLink: TfcChangeLink);
  290. begin
  291.   FChangeLinks.Remove(ChangeLink);
  292. end;
  293. procedure TfcBitmap.TransparentDraw(ACanvas: TCanvas; const Rect: TRect);
  294. var Bmp: TBitmap;
  295. begin
  296.   Bmp := TBitmap.Create;
  297.   Bmp.Width := Width;
  298.   Bmp.Height := Height;
  299.   Bmp.PixelFormat := pf24Bit;
  300.   Bmp.Canvas.CopyRect(Classes.Rect(0, 0, Width, Height), Canvas, Classes.Rect(0, 0, Width, Height));
  301.   fcDrawMask(ACanvas, Rect, Bmp, MaskBitmap, True);
  302.   Bmp.Free;
  303. end;
  304. procedure TfcBitmap.StretchDraw(ACanvas: TCanvas; const Rect: TRect);
  305. var TempBitmap: TfcBitmap;
  306. begin
  307.   if Transparent then
  308.   begin
  309.     TempBitmap := TfcBitmap.Create;
  310.     TempBitmap.LoadBlank(fcRectWidth(Rect), fcRectHeight(Rect));
  311.     StretchBlt(TempBitmap.Canvas.Handle, 0, 0, TempBitmap.Width, TempBitmap.Height,
  312.       FDC, 0, 0, FWidth, FHeight, SRCCOPY);
  313.     TempBitmap.TransparentDraw(ACanvas, Rect);
  314.     TempBitmap.Free;
  315.   end else begin
  316.     SetStretchBltMode(ACanvas.Handle, COLORONCOLOR);
  317.     with Rect do StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
  318.       FDC, 0, 0, FWidth, FHeight, SRCCOPY);
  319.   end;
  320. end;
  321. Procedure TfcBitmap.RestoreBitmapPalette(ACanvas: TCanvas; OldPalette: HPalette);
  322. begin
  323.   if (GetDeviceCaps(FDC, BITSPIXEL) <= 8)
  324.      and (RespectPalette or UseHalftonePalette) then
  325.   begin
  326.     SelectPalette(ACanvas.Handle, OldPalette, True);
  327.     if FPalette <> 0 then
  328.     begin
  329.       DeleteObject(FPalette);
  330.       FPalette := 0;
  331.     end;
  332.   end;
  333. end;
  334. Procedure TfcBitmap.SelectBitmapPalette(ACanvas: TCanvas; var OldPalette: HPalette);
  335. var
  336.     DC: HDC;
  337. begin
  338.   if (GetDeviceCaps(FDC, BITSPIXEL) <= 8) then begin
  339.      if RespectPalette or UseHalftonePalette then
  340.      begin
  341.        if RespectPalette then
  342.        begin
  343.           PaletteNeeded;
  344.        end
  345.        else if UseHalftonePalette then begin
  346.           DC := GetDC(0);
  347.           FPalette := CreateHalftonePalette(DC);
  348.           ReleaseDC(0, DC);
  349.        end;
  350.        OldPalette := SelectPalette(ACanvas.Handle, FPalette, True);
  351.        RealizePalette(ACanvas.Handle);
  352.     end
  353.   end
  354. end;
  355. procedure TfcBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
  356.   function Transparent: Boolean;
  357.   begin
  358.     result := self.Transparent and not Assigning;
  359.   end;
  360.   function SmoothStretching: Boolean;
  361.   begin
  362.     result := self.SmoothStretching and not Assigning;
  363.   end;
  364. var OldPalette: HPALETTE;
  365. //    DC: HDC;
  366. begin
  367.   OldPalette := 0;
  368.   if not SkipPalette then SelectBitmapPalette(ACanvas, OldPalette);
  369. {  if (GetDeviceCaps(FDC, BITSPIXEL) <= 8) and (not SkipPalette) then begin
  370.      if RespectPalette or UseHalftonePalette then
  371.      begin
  372.        if RespectPalette then
  373.        begin
  374.           PaletteNeeded;
  375.        end
  376.        else if UseHalftonePalette then begin
  377.           DC := GetDC(0);
  378.           FPalette := CreateHalftonePalette(DC);
  379.           ReleaseDC(0, DC);
  380.        end;
  381.        OldPalette := SelectPalette(ACanvas.Handle, FPalette, True);
  382.        RealizePalette(ACanvas.Handle);
  383.      end
  384.   end;}
  385.   with Rect do
  386.   begin
  387.     if ((Right - Left) = Width) and ((Bottom - Top) = Height) then
  388.     begin
  389.       if Transparent then TransparentDraw(ACanvas, Rect)
  390.       else BitBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, FDC, 0, 0, SRCCOPY);
  391.     end else begin
  392.       if FSmoothStretching then SmoothStretchDraw(ACanvas, Rect)
  393.       else StretchDraw(ACanvas, Rect);
  394.     end;
  395.   end;
  396.   if not SkipPalette then RestoreBitmapPalette(ACanvas, OldPalette);
  397. {
  398.   if (GetDeviceCaps(FDC, BITSPIXEL) <= 8) and (not SkipPalette)
  399.      and (RespectPalette or UseHalftonePalette) then
  400.   begin
  401.     SelectPalette(ACanvas.Handle, OldPalette, True);
  402.     if FPalette <> 0 then
  403.     begin
  404.       DeleteObject(FPalette);
  405.       FPalette := 0;
  406.     end;
  407.   end;
  408. }
  409. end;
  410. procedure TfcBitmap.Initialize;
  411. var x, i: Integer;
  412.     TempDC: HDC;
  413. begin
  414.   GetMem(Pixels, FHeight * SizeOf(PfcLine));
  415.   FRowInc := (FWidth * 3) + FWidth mod 4;
  416.   FGap := FWidth mod 4;
  417.   FSize := FRowInc * FHeight;
  418.   x := Integer(Bits);
  419.   for i := 0 to Height - 1 do
  420.   begin
  421.     Pixels[i] := Pointer(x);
  422.     Inc(x, RowInc);
  423.   end;
  424.   TempDC := GetDC(0);
  425.   FDC := CreateCompatibleDC(TempDC);
  426.   ReleaseDC(0, TempDC);
  427.   SelectObject(FDC, FHandle);
  428.   if Handle = 0 then CleanUp;
  429.   FCanvas.Handle := FDC;
  430.   Changed(self);
  431. end;
  432. procedure TfcBitmap.PaletteNeeded;
  433. var Pal: TMaxLogPalette;
  434.     DC: HDC;
  435. begin
  436.   if (FPalette <> 0) or (Patch[0]=False) then begin
  437.      DC := GetDC(0);
  438.      { 12/4/99 }
  439.      if Patch[1]=true then FPalette := CreateHalftonePalette(DC);
  440.      ReleaseDC(0, DC);
  441.      exit;
  442.   end;
  443. //  if (FPalette <> 0) or (PInteger(@Colors[0])^ = 0) then Exit;
  444.   Pal.palVersion := $300;
  445.   Pal.palNumEntries := 256;
  446.   Move(Colors, Pal.palPalEntry, 256 * 4);
  447.   if (Pal.palNumEntries <> 16) then
  448.     ByteSwapColors(Pal.palPalEntry, Pal.palNumEntries);
  449.   FPalette := CreatePalette(PLogPalette(@Pal)^);
  450. end;
  451. procedure TfcBitmap.SetHeight(Value: Integer);
  452. begin
  453.   SetSize(Width, Height);
  454. end;
  455. procedure TfcBitmap.SetWidth(Value: Integer);
  456. begin
  457.   SetSize(Value, Height);
  458. end;
  459. procedure TfcBitmap.CleanUp;
  460. begin
  461.   FCanvas.Handle := 0;
  462.   if FDC <> 0 then DeleteDC(FDC);
  463.   if FHandle <> 0 then DeleteObject(FHandle);
  464.   if Pixels <> nil then FreeMem(Pixels);
  465.   if FMaskBitmap <> nil then FMaskBitmap.Free;
  466.   FDC := 0;
  467.   FHandle := 0;
  468.   Pixels := nil;
  469.   FMaskBitmap := nil;
  470.   FWidth := 0;
  471.   FHeight := 0;
  472.   FSize := 0;
  473.   FBits := nil;
  474. end;
  475. procedure TfcBitmap.Clear;
  476. begin
  477.   CleanUp;
  478. end;
  479. procedure TfcBitmap.FreeMemoryImage;
  480. begin
  481.   FreeMem(FMemoryImage);
  482.   FMemoryImage := nil;
  483.   FMemoryDim := fcSize(0, 0);
  484.   FMemorySize := 0;
  485. end;
  486. procedure TfcBitmap.InitHeader;
  487. begin
  488.   with bmHeader do
  489.   begin
  490.     biSize := SizeOf(bmHeader);
  491.     biWidth := Width;
  492.     biHeight := -Height;
  493.     biPlanes := 1;
  494.     biBitCount := 24;
  495.     biCompression := BI_RGB;
  496.   end;
  497. end;
  498. procedure TfcBitmap.LoadBlank(AWidth, AHeight: Integer);
  499. begin
  500.   CleanUp;
  501.   if (AWidth = 0) or (AHeight = 0) then Exit;
  502.   FWidth := AWidth;
  503.   FHeight := AHeight;
  504.   InitHeader;
  505.   bmInfo.bmiHeader := bmHeader;
  506.   FHandle := CreateDIBSection(0, bmInfo, DIB_RGB_COLORS, FBits, 0, 0);
  507.   Initialize;
  508.   FCanvas.Brush.Color := clWhite;
  509.   FCanvas.FillRect(Rect(0, 0, FWidth, FHeight));
  510. end;
  511. procedure TfcBitmap.LoadFromBitmap(Bitmap: TBitmap);
  512. var MemDC: Integer;
  513.   { RSW - 3/2/99}
  514.   procedure SetPixelFormat;
  515.   var DS: TDIBSection;
  516.   begin
  517.     DS.dsbmih.biSize := 0;
  518.     GetObject(Bitmap.Handle, SizeOf(DS), @DS);
  519.     MemDC := GetDC(0);
  520.     Patch[1]:=  { 12/4/99 }
  521.        ((GetDeviceCaps(MemDC, BITSPIXEL) * GetDeviceCaps(MemDC, PLANES)) <
  522.        ((ds.dsbm.bmBitsPixel * ds.dsbm.bmPlanes)));
  523.     ReleaseDC(0, MemDC);
  524.     FPixelFormat:= Bitmap.PixelFormat;
  525.     if Bitmap.PixelFormat <> pfCustom then exit;
  526. //    DS.dsbmih.biSize := 0;
  527. //    GetObject(Bitmap.Handle, SizeOf(DS), @DS);
  528.     case DS.dsbmih.biBitCount of
  529.     1: FPixelFormat:= pf1bit;
  530.     4: FPixelFormat:= pf4bit;
  531.     8: FPixelFormat:= pf8bit;
  532.     16: FPixelFormat:= pf16bit;
  533.     24: FPixelFormat:= pf24bit;
  534.     32: FPixelFormat:= pf32bit;
  535.     end;
  536.   end;
  537. begin
  538.   CleanUp;
  539.   FWidth := Bitmap.Width;
  540.   FHeight := Bitmap.Height;
  541.   FSize := ((FWidth * 3) + (FWidth mod 4)) * FHeight;
  542.   InitHeader;
  543.   bmInfo.bmiHeader := bmHeader;
  544.   FHandle := CreateDIBSection(0, bmInfo, DIB_RGB_COLORS, FBits, 0, 0);
  545.   MemDC := GetDC(0);
  546.   GetDIBits(MemDC, Bitmap.Handle, 0, FHeight, FBits, bmInfo, DIB_RGB_COLORS);
  547.   ReleaseDC(0, MemDC);
  548.   Initialize;
  549. //  FPixelFormat := Bitmap.PixelFormat;
  550.   SetPixelFormat;
  551.   Patch[0]:= GetDIBColorTable(Bitmap.Canvas.Handle, 0, 256, Colors)<>0;
  552. end;
  553. procedure TfcBitmap.LoadFromJPEG(JPEG: TGraphic);
  554. var ABitmap: TBitmap;
  555. begin
  556.   ABitmap := TBitmap.Create;
  557.   ABitmap.Width := JPEG.Width;
  558.   ABitmap.Height := JPEG.Height;
  559.   ABitmap.Canvas.Draw(0, 0, JPEG);
  560.   LoadFromBitmap(ABitmap);
  561.   ABitmap.Free;
  562. end;
  563. procedure TfcBitmap.LoadFromGraphic(Graphic: TGraphic);
  564. var ABitmap: TBitmap;
  565. begin
  566.   ABitmap := TBitmap.Create;
  567.   //11/1/2001 - Use Draw as this is more generic...
  568.   //  ABitmap.Assign(Graphic);
  569.   ABitmap.Width := Graphic.Width;
  570.   ABitmap.Height:= Graphic.Height;
  571.   ABitmap.Canvas.Draw(0,0,Graphic);
  572.   LoadFromBitmap(ABitmap);
  573.   ABitmap.Free;
  574. end;
  575. procedure TfcBitmap.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  576.   APalette: HPALETTE);
  577. begin
  578. end;
  579. procedure TfcBitmap.LoadFromMemory(ABits: Pointer; ASize: Integer; Dimensions: TSize);
  580. var MemDC: Integer;
  581.     TempBmHandle: HBITMAP;
  582. begin
  583.   CleanUp;
  584.   FWidth := Dimensions.cx;
  585.   FHeight := Dimensions.cy;
  586.   FSize := ASize;
  587.   InitHeader;
  588.   bmInfo.bmiHeader := bmHeader;
  589.   MemDC := GetDC(0);
  590.   FHandle := CreateDIBSection(0, bmInfo, DIB_RGB_COLORS, FBits, 0, 0);
  591.   TempBmHandle := CreateDIBitmap(MemDC, bmHeader, CBM_INIT, ABits, bmInfo, DIB_RGB_COLORS);
  592.   GetDIBits(MemDC, TempBmHandle, 0, FHeight, FBits, bmInfo, DIB_RGB_COLORS);
  593.   DeleteObject(TempBmHandle);
  594.   ReleaseDC(0, MemDC);
  595.   Initialize;
  596. end;
  597. procedure TfcBitmap.LoadFromStream(Stream: TStream);
  598. var Bitmap: TBitmap;
  599. begin
  600.   Bitmap := TBitmap.Create;
  601.   try
  602.     Bitmap.LoadFromStream(Stream);
  603.     LoadFromBitmap(Bitmap);
  604.   finally
  605.     Bitmap.Free;
  606.   end;
  607. end;
  608. procedure TfcBitmap.SaveToBitmap(Bitmap: TBitmap);
  609. begin
  610.   Bitmap.PixelFormat := FPixelFormat;
  611.   Bitmap.Width := Width;
  612.   Bitmap.Height := Height;
  613.   SetDIBColorTable(Bitmap.Canvas.Handle, 0, 256, Colors);
  614.   Assigning := True;
  615.   Bitmap.Canvas.Draw(0, 0, self);
  616.   Assigning := False;
  617. end;
  618. procedure TfcBitmap.SetSize(const AWidth, AHeight: Integer);
  619. begin
  620.   if (AWidth <> Width) or (AHeight <> Height) then
  621.     LoadBlank(AWidth, AHeight);
  622. end;
  623. procedure TfcBitmap.SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  624.   var APalette: HPALETTE);
  625. begin
  626. end;
  627. procedure TfcBitmap.SaveToStream(Stream: TStream);
  628. var Bitmap: TBitmap;
  629. begin
  630.   Bitmap := TBitmap.Create;
  631.   try
  632.     SaveToBitmap(Bitmap);
  633.     Bitmap.SaveToStream(Stream);
  634.   finally
  635.     Bitmap.Free;
  636.   end;
  637. end;
  638. function TfcBitmap.GetMaskBitmap: TBitmap;
  639. var Bitmap: TfcBitmap;
  640.     TranColor: TfcColor;
  641. begin
  642.   if FMaskBitmap = nil then
  643.   begin
  644.     FMaskBitmap := TBitmap.Create;
  645.     Bitmap := TfcBitmap.Create;
  646.     Bitmap.Assign(self);
  647.     TranColor := Bitmap.Pixels[0, 0];
  648.     if TransparentColor <> clNone then TranColor := fcGetColor(TransparentColor);
  649.     Bitmap.Mask(TranColor);
  650.     FMaskBitmap.Assign(Bitmap);
  651.     FMaskBitmap.Monochrome := True;
  652.     Bitmap.Free;
  653.   end;
  654.   result := FMaskBitmap;
  655. end;
  656. function TfcBitmap.CopyPixels: PfcPLines;
  657. begin
  658.   GetMem(result, FHeight * SizeOf(PfcLine));
  659.   CopyMemory(result, Pixels, FHeight * SizeOf(PfcLine));
  660. end;
  661. procedure TfcBitmap.Fill(Color: TColor);
  662. var Brush: HBRUSH;
  663. begin
  664.   Brush := CreateSolidBrush(ColorToRGB(Color));
  665.   try
  666.     FillRect(FDC, Rect(0, 0, FWidth, FHeight), Brush);
  667.   finally
  668.     DeleteObject(Brush);
  669.   end;
  670. end;
  671. procedure TfcBitmap.Resize(AWidth, AHeight: Integer);
  672. var ABitmap: TfcBitmap;
  673. begin
  674.   if (AWidth = Width) and (AHeight = Height) then Exit;
  675.   ABitmap := TfcBitmap.Create;
  676.   try
  677.     ABitmap.Assign(self);
  678.     LoadBlank(AWidth, AHeight);
  679.     Canvas.StretchDraw(Rect(0, 0, AWidth, AHeight), ABitmap);
  680.   finally
  681.     ABitmap.Free;
  682.   end;
  683. end;
  684. procedure TfcBitmap.SmoothStretchDraw(ACanvas: TCanvas; Rect: TRect);
  685. var x, y, xP, yP, yP2, xP2: Integer;
  686.     Read, Read2: PfcLine;
  687.     t, z, z2, iz2: Integer;
  688.     pc: PfcColor;
  689.     w1,w2,w3,w4: Integer;
  690.     Col1,Col2:   PfcColor;
  691.     Dst: TfcBitmap;
  692. begin
  693.   Dst := TfcBitmap.Create;
  694.   Dst.LoadBlank(fcRectWidth(Rect), fcRectHeight(Rect));
  695.   if(Dst.FWidth<1)or(Dst.FHeight<1)then Exit;
  696.   if(Dst.FWidth=FWidth)and(Dst.FHeight=FHeight)then
  697.   begin
  698.     CopyMemory(Dst.FBits, FBits, FSize);
  699.     Exit;
  700.   end;
  701.   xP2:=((FWidth-1)shl 15)div Dst.FWidth;
  702.   yP2:=((FHeight-1)shl 15)div Dst.FHeight;
  703.   yP:=0;
  704.   for y:=0 to Dst.FHeight-1 do
  705.   begin
  706.     xP:=0;
  707.     Read:=Pixels[yP shr 15];
  708.     if yP shr 16<FHeight-1 then
  709.       Read2:=Pixels[yP shr 15+1]
  710.     else
  711.       Read2:=Pixels[yP shr 15];
  712.     pc:=@Dst.Pixels[y,0];
  713.     z2:=yP and $7FFF;
  714.     iz2:=$8000-z2;
  715.     for x:=0 to Dst.FWidth-1 do
  716.     begin
  717.       t:=xP shr 15;
  718.       Col1:=@Read[t];
  719.       Col2:=@Read2[t];
  720.       z:=xP and $7FFF;
  721.       w2:=(z*iz2)shr 15;
  722.       w1:=iz2-w2;
  723.       w4:=(z*z2)shr 15;
  724.       w3:=z2-w4;
  725.       pc.b:=
  726.         (Col1.b*w1+PfcColor(Integer(Col1)+3).b*w2+
  727.          Col2.b*w3+PfcColor(Integer(Col2)+3).b*w4)shr 15;
  728.       pc.g:=
  729.         (Col1.g*w1+PfcColor(Integer(Col1)+3).g*w2+
  730.          Col2.g*w3+PfcColor(Integer(Col2)+3).g*w4)shr 15;
  731.       pc.r:=
  732.         (Col1.r*w1+PfcColor(Integer(Col1)+3).r*w2+
  733.          Col2.r*w3+PfcColor(Integer(Col2)+3).r*w4)shr 15;
  734.       Inc(pc);
  735.       Inc(xP,xP2);
  736.     end;
  737.     Inc(yP,yP2);
  738.   end;
  739.   if Transparent then Dst.TransparentDraw(ACanvas, Rect)
  740.   else ACanvas.Draw(Rect.Left, Rect.Top, Dst);
  741.   Dst.Free;
  742. end;
  743. procedure TfcBitmap.TileDraw(ACanvas: TCanvas; ARect: TRect);
  744. var RectSize: TSize;
  745.     i, j: Integer;
  746.     OldPalette: HPalette;
  747. begin
  748.   if Empty then exit; { 4/5/99 - RSW }
  749.   { 4/10/99 - RSW - Code changed so that tiledraw paints at least to bottom right of ARect }
  750.   with ARect, RectSize do
  751.   begin
  752.     cx := Right;
  753.     cy := Bottom;
  754.   end;
  755. {  with ARect, RectSize do
  756.   begin
  757.     cx := Right - Left;
  758.     cy := Bottom - Top;
  759.   end;
  760. }
  761.   j := 0;
  762.   SkipPalette:= true;
  763.   SelectBitmapPalette(ACanvas, OldPalette);
  764.   while j < RectSize.cy do
  765.   begin
  766.     i := 0;
  767.     while i < RectSize.cx do
  768.     begin
  769.       ACanvas.Draw(i - ARect.Left, j - ARect.Top, self);
  770.       inc(i, FWidth);
  771.     end;
  772.     inc(j, FHeight);
  773.   end;
  774.   SkipPalette:= False;
  775.   RestoreBitmapPalette(ACanvas, OldPalette);
  776. end;
  777. // Filter Methods
  778. procedure TfcBitmap.Brightness(Amount: Integer);
  779. var x,y: Integer;
  780.     Table: array[0..255] of Byte;
  781.     CurBits: PfcColor;
  782. begin
  783.   if Amount > 0 then
  784.     for x:=0 to 255 do Table[x] := fcIntToByte(x + ((Amount * (x xor 255)) shr 8))
  785.   else for x:=0 to 255 do Table[x] := fcIntToByte(x - ((Abs(Amount) * x) shr 8));
  786.   CurBits := Bits;
  787.   for y := 1 to FHeight do
  788.   begin
  789.     for x := 1 to FWidth do
  790.     begin
  791.       CurBits.b := Table[CurBits.b];
  792.       CurBits.g := Table[CurBits.g];
  793.       CurBits.r := Table[CurBits.r];
  794.       Inc(CurBits);
  795.     end;
  796.     CurBits := Pointer(Integer(CurBits) + Gap);
  797.   end;
  798. end;
  799. procedure TfcBitmap.Saturation(Amount: Integer);
  800. var Grays: array[0..255] of Byte;
  801.     Alpha: array[0..255] of Word;
  802.     Gray: Byte;
  803.     x, y, ag: Integer;
  804.     CurBits: TfcColor;
  805.     pc: PfcColor;
  806. begin
  807.   x:=0;
  808.   y:=0;
  809.   for ag := 0 to 85 do
  810.   begin
  811.     Grays[x + 0] := y;
  812.     Grays[x + 1] := y;
  813.     Grays[x + 2] := y;
  814.     Inc(y);
  815.     Inc(x, 3);
  816.   end;
  817.   for x := 0 to 255 do Alpha[x] := (x * Amount) shr 8;
  818.   pc := Bits;
  819.   for y := 0 to FHeight - 1 do
  820.   begin
  821.     for x := 0 to FWidth - 1 do
  822.     begin
  823.       CurBits := pc^;
  824.       Gray := Grays[CurBits.r] + Grays[CurBits.g] + Grays[CurBits.b];
  825.       ag := Alpha[Gray];
  826.       pc.b := fcIntToByte(Gray + (Alpha[CurBits.b] - ag));
  827.       pc.g := fcIntToByte(Gray + (Alpha[CurBits.g] - ag));
  828.       pc.r := fcIntToByte(Gray + (Alpha[CurBits.r] - ag));
  829.       Inc(pc);
  830.     end;
  831.     pc := Pointer(Integer(pc) + Gap);
  832.   end;
  833. end;
  834. procedure TfcBitmap.ColorTint(ra, ga, ba: Integer);
  835. var Table: array[0..255] of TfcColor;
  836.     x, y, i: Integer;
  837.     CurBits: PfcColor;
  838. begin
  839.   for i := 0 to 255 do
  840.   begin
  841.     Table[i].b := fcIntToByte(i + ba);
  842.     Table[i].g := fcIntToByte(i + ga);
  843.     Table[i].r := fcIntToByte(i + ra);
  844.   end;
  845.   CurBits := Bits;
  846.   for y := 0 to Height - 1 do
  847.   begin
  848.     for x := 0 to Width - 1 do
  849.     begin
  850.       CurBits.b := Table[CurBits.b].b;
  851.       CurBits.g := Table[CurBits.g].g;
  852.       CurBits.r := Table[CurBits.r].r;
  853.       Inc(CurBits);
  854.     end;
  855.     CurBits := Pointer(Integer(CurBits) + Gap);
  856.   end;
  857. end;
  858. procedure TfcBitmap.Colorize(ra, ga, ba: Integer);
  859. var x, y: Integer;
  860.     CurBits: PfcColor;
  861.     Tran: Boolean;
  862.     TranColor: TfcColor;
  863. begin
  864.   CurBits := Bits;
  865.   Tran := FTransparentColor <> clNone;
  866.   TranColor := fcGetColor(FTransparentColor);
  867.   for y := 0 to Height - 1 do
  868.   begin
  869.     for x := 0 to Width - 1 do
  870.     begin
  871.       with TranColor do if not Tran or (Tran and not ((r = Pixels[y, x].r) and (g = Pixels[y, x].g) and (b = Pixels[y, x].b))) then
  872.       begin
  873.         CurBits.b := fcIntToByte((CurBits.b - 192) + ba);
  874.         CurBits.g := fcIntToByte((CurBits.g - 192) + ga);
  875.         CurBits.r := fcIntToByte((CurBits.r - 192) + ra);
  876.       end;
  877.       Inc(CurBits);
  878.     end;
  879.     CurBits := Pointer(Integer(CurBits) + Gap);
  880.   end;
  881. end;
  882. procedure TfcBitmap.Contrast(Amount: Integer);
  883. var x, y: Integer;
  884.     Table: array[0..255] of Byte;
  885.     CurBits: PfcColor;
  886. begin
  887.   for x := 0 to 126 do
  888.   begin
  889.     y := (Abs(128 - x) * Amount) div 256;
  890.     y := x - y;
  891.     Table[x] := fcIntToByte(y);
  892.   end;
  893.   for x := 127 to 255 do
  894.   begin
  895.     y := (Abs(128 - x) * Amount) div 256;
  896.     y := x + y;
  897.     Table[x] := fcIntToByte(y);
  898.   end;
  899.   CurBits := Bits;
  900.   for y := 1 to FHeight do
  901.   begin
  902.     for x := 1 to FWidth do
  903.     begin
  904.       CurBits.b := Table[CurBits.b];
  905.       CurBits.g := Table[CurBits.g];
  906.       CurBits.r := Table[CurBits.r];
  907.       Inc(CurBits);
  908.     end;
  909.     CurBits := Pointer(Integer(CurBits) + Gap);
  910.   end;
  911. end;
  912. procedure TfcBitmap.AlphaBlend(Bitmap: TfcBitmap; Alpha: Integer; Stretch: Boolean);
  913. var x, y, i: Integer;
  914.     c1, c2, c3: PfcColor;
  915.     Table: array[-255..255] of Integer;
  916.     TranColor: TfcColor;
  917.     Tran: Boolean;
  918.     PassedBm: TfcBitmap;
  919. begin
  920.   PassedBm := nil;
  921.   if (Width <> Bitmap.Width) or (Height <> Bitmap.Height) then
  922.   begin
  923.     if not Stretch then raise EInvalidOperation.Create('In Alpha Blend, Blend Bitmap must be same dimensions as Current Bitmap')
  924.     else begin
  925.       PassedBm := Bitmap;
  926.       Tran := PassedBm.Transparent;
  927.       PassedBm.Transparent := False;
  928.       Bitmap := TfcBitmap.Create;
  929.       Bitmap.Transparent := Tran;
  930.       Bitmap.LoadBlank(Width, Height);
  931.       Bitmap.Canvas.StretchDraw(Rect(0, 0, Width - 1, Height - 1), PassedBm);
  932.       PassedBm.Transparent := Tran;
  933.     end;
  934.   end;
  935.   for i := -255 to 255 do Table[i] := (Alpha * i) shr 8;
  936.   TranColor := fcGetColor(0);
  937.   c1 := Bits;
  938.   c2 := Bitmap.Bits;
  939.   c3 := Bits;
  940.   Tran := Bitmap.Transparent and (Bitmap.Height = Height) and (Bitmap.Width = Width);
  941.   if Tran then
  942.   begin
  943. {    if TransparentColor = clNone then TranColor := c2^
  944.     else TranColor := fcGetColor(TransparentColor);}
  945.     TranColor := c2^;
  946.   end;
  947.   for y := 0 to FHeight - 1 do
  948.   begin
  949.     for x := 0 to FWidth - 1 do
  950.     begin
  951.       if not Tran or (Tran and not ((c2.r = TranColor.r) and (c2.g = TranColor.g) and (c2.b = TranColor.b))) then
  952.       begin
  953.         c1.b := Table[c2.b - c3.b] + c3.b;
  954.         c1.g := Table[c2.g - c3.g] + c3.g;
  955.         c1.r := Table[c2.r - c3.r] + c3.r;
  956.       end;
  957.       Inc(c1);
  958.       Inc(c2);
  959.       Inc(c3);
  960.     end;
  961.     c1 := Pointer(Integer(c1) + Gap);
  962.     c2 := Pointer(Integer(c2) + Bitmap.Gap);
  963.     c3 := Pointer(Integer(c3) + Gap);
  964.   end;
  965.   if PassedBm <> nil then Bitmap.Free;
  966. end;
  967. procedure TfcBitmap.Grayscale;
  968. var Grays: array[0..256] of Byte;
  969.     i, x, y: Integer;
  970.     CurBits: PfcColor;
  971. begin
  972.   x := 0; y := 0;
  973.   for i := 0 to 85 do
  974.   begin
  975.     Grays[x + 0] := y;
  976.     Grays[x + 1] := y;
  977.     Grays[x + 2] := y;
  978.     Inc(y);
  979.     Inc(x, 3);
  980.   end;
  981.   CurBits := Bits;
  982.   for y := 0 to FHeight - 1 do
  983.   begin
  984.     for x := 0 to FWidth - 1 do
  985.     begin
  986.       i := Grays[CurBits.b] + Grays[CurBits.g] + Grays[CurBits.r];
  987.       CurBits.b := i;
  988.       CurBits.g := i;
  989.       CurBits.r := i;
  990.       Inc(CurBits);
  991.     end;
  992.     CurBits := Pointer(Integer(CurBits) + Gap);
  993.   end;
  994. end;
  995. procedure TfcBitmap.Invert;
  996. var x, y: Integer;
  997.     CurBits: PfcColor;
  998. begin
  999.   CurBits := Bits;
  1000.   for y := 0 to FHeight - 1 do
  1001.   begin
  1002.     for x := 0 to Width - 1 do
  1003.     begin
  1004.       CurBits.b := CurBits.b xor 255;
  1005.       CurBits.g := CurBits.g xor 255;
  1006.       CurBits.r := CurBits.r xor 255;
  1007.       Inc(CurBits);
  1008.     end;
  1009.     CurBits := Pointer(Integer(CurBits) + Gap);
  1010.   end;
  1011. end;
  1012. procedure TfcBitmap.Flip(Horizontal: Boolean);
  1013. var w, h, x, y: Integer;
  1014.     CurBits:  TfcColor;
  1015.     TmpLine, TmpLine2, Line: PfcLine;
  1016.     TopY: Integer;
  1017. begin
  1018.   TmpLine := nil;
  1019.   w := FWidth - 1;
  1020.   h := FHeight - 1;
  1021.   TopY := FHeight - 1;
  1022.   if not Horizontal then
  1023.   begin
  1024.     TopY := h div 2;
  1025.     GetMem(TmpLine, RowInc);
  1026.   end;
  1027.   try
  1028.     Line := Bits;
  1029.     for y := 0 to TopY do
  1030.     begin
  1031.       if Horizontal then for x := 0 to w div 2 do
  1032.       begin
  1033.         CurBits := Line[x];
  1034.         Line[x] := Line[w - x];
  1035.         Line[w - x] := CurBits;
  1036.       end else begin
  1037.         TmpLine2 := Pointer(Integer(Bits) + (h - y) * RowInc);
  1038.         CopyMemory(TmpLine, Line, RowInc);
  1039.         CopyMemory(Line, TmpLine2, RowInc);
  1040.         CopyMemory(TmpLine2, TmpLine, RowInc);
  1041.       end;
  1042.       Line := Pointer(Integer(Line) + RowInc);
  1043.     end;
  1044.   finally
  1045.     if not Horizontal then FreeMem(TmpLine);
  1046.   end;
  1047. end;
  1048. procedure TfcBitmap.Blur(Amount: Integer);
  1049. var Lin1, Lin2: PfcLine;
  1050.     pc: PfcColor;
  1051.     cx, x, y: Integer;
  1052.     Buf: array[0..3] of TfcColor;
  1053. begin
  1054.   pc := Bits;
  1055.   for y := 0 to FHeight - 1 do
  1056.   begin
  1057.     Lin1 := Pixels[fcTrimInt(y + Amount, 0, FHeight - 1)];
  1058.     Lin2 := Pixels[fcTrimInt(y - Amount, 0, FHeight - 1)];
  1059.     for x := 0 to FWidth - 1 do
  1060.     begin
  1061.       cx := fcTrimInt(x + Amount, 0, FWidth - 1);
  1062.       Buf[0] := Lin1[cx];
  1063.       Buf[1] := Lin2[cx];
  1064.       cx := fcTrimInt(x - Amount, 0, Width - 1);
  1065.       Buf[2] := Lin1[cx];
  1066.       Buf[3] := Lin2[cx];
  1067.       pc.b := (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b) shr 2;
  1068.       pc.g := (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g) shr 2;
  1069.       pc.r := (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r) shr 2;
  1070.       Inc(pc);
  1071.     end;
  1072.     pc := Pointer(Integer(pc) + Gap);
  1073.   end;
  1074. end;
  1075. procedure TfcBitmap.GaussianBlur(Amount: Integer);
  1076. var i: Integer;
  1077. begin
  1078.   for i := Amount downto 1 do
  1079.   Blur(i);
  1080. end;
  1081. procedure TfcBitmap.Sharpen(Amount: Integer);
  1082. var Lin0, Lin1, Lin2: PfcLine;
  1083.     pc: PfcColor;
  1084.     cx, x, y: Integer;
  1085.     Buf: array[0..8] of TfcColor;
  1086. begin
  1087.   pc := Bits;
  1088.   for y := 0 to FHeight - 1 do
  1089.   begin
  1090.     Lin0 := Pixels[fcTrimInt(y - Amount, 0, Height - 1)];
  1091.     Lin1 := Pixels[y];
  1092.     Lin2 := Pixels[fcTrimInt(y + Amount, 0, FHeight - 1)];
  1093.     for x := 0 to FWidth - 1 do
  1094.     begin
  1095.       cx := fcTrimInt(x - Amount, 0, FWidth - 1);
  1096.       Buf[0]:=Lin0[cx];
  1097.       Buf[1]:=Lin1[cx];
  1098.       Buf[2]:=Lin2[cx];
  1099.       Buf[3]:=Lin0[x];
  1100.       Buf[4]:=Lin1[x];
  1101.       Buf[5]:=Lin2[x];
  1102.       cx := fcTrimInt(x + Amount, 0, FWidth - 1);
  1103.       Buf[6]:=Lin0[cx];
  1104.       Buf[7]:=Lin1[cx];
  1105.       Buf[8]:=Lin2[cx];
  1106.       pc.b := fcIntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b +
  1107.         Buf[2].b + Buf[3].b + Buf[5].b + Buf[6].b + Buf[7].b +
  1108.         Buf[8].b) * 16) div 128);
  1109.       pc.g := fcIntToByte((256*Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g +
  1110.         Buf[3].g + Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16)
  1111.         div 128);
  1112.       pc.r := fcIntToByte((256*Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r +
  1113.         Buf[3].r + Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16)
  1114.         div 128);
  1115.       Inc(pc);
  1116.     end;
  1117.     pc := Pointer(Integer(pc) + Gap);
  1118.   end;
  1119. end;
  1120. procedure TfcBitmap.Sponge(Amount: Integer);
  1121. var r, x, y: Integer;
  1122. begin
  1123.   for y := 0 to FHeight - 1 do
  1124.     for x := 0 to FWidth - 1 do
  1125.     begin
  1126.       r := Random(Amount);
  1127.       Pixels[y, x] := Pixels[
  1128.         fcTrimInt(y + (r - Random(r * 2)), 0, FHeight - 1),
  1129.         fcTrimInt(x + (r - Random(r * 2)), 0, FWidth - 1)
  1130.       ];
  1131.     end;
  1132. end;
  1133. procedure TfcBitmap.Emboss;
  1134. var x, y: Integer;
  1135.     p1, p2: PfcColor;
  1136.     Line: PfcLine;
  1137. begin
  1138.   p1 := Bits;
  1139.   p2 := Pointer(Integer(p1) + RowInc + 3);
  1140.   GetMem(Line, RowInc);
  1141.   CopyMemory(Line, Pixels[FHeight - 1], RowInc);
  1142.   for y := 0 to Height - 1 do
  1143.   begin
  1144.     for x := 0 to Width - 1 do
  1145.     begin
  1146.       p1.b := (p1.b + (p2.b xor $FF)) shr 1;
  1147.       p1.g := (p1.g + (p2.g xor $FF)) shr 1;
  1148.       p1.r := (p1.r + (p2.r xor $FF)) shr 1;
  1149.       Inc(p1);
  1150.       if(y < FHeight - 2) and (x < FWidth - 2) then Inc(p2);
  1151.     end;
  1152.     p1 := Pointer(Integer(p1) + FGap);
  1153.     if y < FHeight - 2 then p2 := Pointer(Integer(p2) + Gap + 6)
  1154.     else p2 := Pointer(Integer(Line) + 3);
  1155.   end;
  1156.   FreeMem(Line);
  1157. end;
  1158. procedure TfcBitmap.Mask(MaskColor: TfcColor);
  1159. var x, y: Integer;
  1160. begin
  1161.   for y := 0 to FHeight - 1 do
  1162.     for x := 0 to FWidth - 1 do
  1163.       with Pixels[y, x] do
  1164.     begin
  1165.       if (r = MaskColor.r) and (g = MaskColor.g) and (b = MaskColor.b) then
  1166.         Pixels[y, x] := fcRGB(0, 0, 0)
  1167.       else Pixels[y, x] := fcRGB(255, 255, 255);
  1168.     end;
  1169. end;
  1170. procedure TfcBitmap.ChangeColor(OldColor: TfcColor; NewColor: TfcColor);
  1171. var x, y: Integer;
  1172. begin
  1173.   for y := 0 to FHeight - 1 do
  1174.     for x := 0 to FWidth - 1 do
  1175.       with Pixels[y, x] do
  1176.     begin
  1177.       if (r = OldColor.r) and (g = OldColor.g) and (b = OldColor.b) then
  1178.         Pixels[y, x] := NewColor;
  1179.     end;
  1180. end;
  1181. procedure TfcBitmap.Wave(XDiv, YDiv, RatioVal: Extended; Wrap: Boolean);
  1182. type
  1183.   TArray = array[0..0]of Integer;
  1184.   PArray = ^TArray;
  1185. var i, j, XSrc, YSrc: Integer;
  1186.     st: PArray;
  1187.     Pix: PfcColor;
  1188.     Line: PfcLine;
  1189.     Dst: TfcBitmap;
  1190.     Max: Integer;
  1191.     PInt: PInteger;
  1192. begin
  1193.   if (YDiv = 0) or (XDiv = 0) then Exit;
  1194.   Line := nil;
  1195.   Max := 0;
  1196.   Dst := TfcBitmap.Create;
  1197.   Dst.LoadBlank(FWidth, FHeight);
  1198.   GetMem(st, 4 * FHeight);
  1199.   try
  1200.     for j := 0 to FHeight - 1 do
  1201.       st[j] := Round(RatioVal * Sin(j / YDiv));
  1202.     if Wrap then Max := Integer(Pixels[FHeight - 1]) + RowInc;
  1203.     for i := 0 to FWidth - 1 do
  1204.     begin
  1205.       YSrc := Round(RatioVal * Sin(i / XDiv));
  1206.       if Wrap then
  1207.       begin
  1208.         if YSrc < 0 then YSrc := FHeight - 1 - (-YSrc mod FHeight)
  1209.         else if YSrc >= FHeight then YSrc := YSrc mod (FHeight - 1);
  1210.       end;
  1211.       Pix := Pointer(Integer(Dst.Bits) + i * 3);
  1212.       if ((YSrc >= 0) and (YSrc < FHeight)) or Wrap then Line := Pixels[YSrc];
  1213.       PInt := PInteger(st);
  1214.       for j := 0 to FHeight - 1 do
  1215.       begin
  1216.         if Wrap then
  1217.         begin
  1218.           XSrc := i + PInt^;
  1219.           Inc(PInt);
  1220.           if XSrc < 0 then
  1221.             XSrc := FWidth - 1 - (-XSrc mod FWidth)
  1222.           else if XSrc >= FWidth then
  1223.             XSrc := XSrc mod FWidth;
  1224.           Pix^ := Line[XSrc];
  1225.           Pix := Pointer(Integer(Pix) + Dst.RowInc);
  1226.           Line := Pointer(Integer(Line) + FRowInc);
  1227.           if Integer(Line) >= Max then Line := FBits;
  1228.         end else begin
  1229.           if (YSrc >= FHeight) then Break;
  1230.           XSrc := i + st[j];
  1231.           if (XSrc > -1) and (XSrc < FWidth) and (YSrc > -1) then
  1232.             Pix^ := Line^[XSrc]
  1233.           else if YSrc = -1 then
  1234.           begin
  1235.             Pix := Pointer(Integer(Pix) + Dst.RowInc);
  1236.             Line := FBits;
  1237.             YSrc:=0;
  1238.             Continue;
  1239.           end;
  1240.           Pix := Pointer(Integer(Pix) + Dst.RowInc);
  1241.           Line := Pointer(Integer(Line) + RowInc);
  1242.           Inc(YSrc);
  1243.         end;
  1244.       end;
  1245.     end;
  1246.     CopyMemory(FBits, Dst.Bits, FSize);
  1247.   finally
  1248.     FreeMem(st);
  1249.     Dst.Free;
  1250.   end;
  1251. end;
  1252. procedure TfcBitmap.Rotate(Center: TPoint; Angle: Extended);
  1253. var cAngle, sAngle: Double;                   // Cos Angle, Sin Angle, respectively
  1254.     SrcX, SrcY, px, py, x, y: Integer;
  1255.     CurBits: PfcColor;
  1256.     Dst: TfcBitmap;
  1257. begin
  1258.   if Center.x < 0 then Center.X := FWidth div 2;
  1259.   if Center.y < 0 then Center.Y := FHeight div 2;
  1260.   Dst := TfcBitmap.Create;
  1261.   Dst.LoadBlank(Width, Height);
  1262.   Dst.Canvas.Brush.Color := fcGetStdColor(Pixels[0, 0]);
  1263.   Dst.Canvas.FillRect(Rect(0, 0, Dst.Width, Dst.Height));
  1264.   Angle := -Angle * Pi / 180;
  1265.   sAngle := Sin(Angle);
  1266.   cAngle := Cos(Angle);
  1267.   CurBits := Dst.Bits;
  1268.   for y := 0 to Dst.Height - 1 do
  1269.   begin
  1270.     py := 2 * (y - Center.y) + 1;
  1271.     for x := 0 to Dst.Width - 1 do
  1272.     begin
  1273.       px := 2 * (x - Center.x) + 1;
  1274.       SrcX := ((Round(px * cAngle - py * sAngle) - 1) div 2 + Center.x);
  1275.       SrcY:= ((Round(px * sAngle + py * cAngle) - 1) div 2 + Center.y);
  1276.       if (SrcX > -1) and (SrcX < FWidth) and (SrcY > -1) and (SrcY < FHeight) then
  1277.         CurBits^ := Pixels[SrcY, SrcX];
  1278.       Inc(CurBits);
  1279.     end;
  1280.     CurBits := Pointer(Integer(CurBits) + Dst.Gap);
  1281.   end;
  1282.   CopyMemory(FBits, Dst.Bits, FSize);
  1283.   Dst.Free;
  1284. end;
  1285. procedure TfcBitmap.Sleep;
  1286. begin
  1287.   if Sleeping then FreeMemoryImage;
  1288.   FMemorySize := FSize;
  1289.   FMemoryDim := fcSize(Width, Height);
  1290.   GetMem(FMemoryImage, FMemorySize);
  1291.   CopyMemory(FMemoryImage, FBits, FMemorySize);
  1292.   CleanUp;
  1293. end;
  1294. procedure TfcBitmap.Wake;
  1295. begin
  1296.   if (FMemoryImage = nil) or (FMemorySize = 0) then Exit;
  1297.   LoadFromMemory(FMemoryImage, FMemorySize, FMemoryDim);
  1298.   FreeMemoryImage;
  1299. end;
  1300. {$R+}
  1301. end.