fpimgcanv.pp 2.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 2003 by the Free Pascal development team
  5. Image Canvas - canvas which draws on an image.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}{$h+}
  13. unit FPImgCanv;
  14. interface
  15. uses FPPixlCanv, FPImage, classes;
  16. type
  17. TFPImageCanvas = class (TFPPixelCanvas)
  18. private
  19. FImage : TFPCustomImage;
  20. protected
  21. procedure SetColor (x,y:integer; AValue:TFPColor); override;
  22. function GetColor (x,y:integer) : TFPColor; override;
  23. procedure SetHeight (AValue : integer); override;
  24. function GetHeight : integer; override;
  25. procedure SetWidth (AValue : integer); override;
  26. function GetWidth : integer; override;
  27. public
  28. constructor create (AnImage : TFPCustomImage);
  29. destructor destroy; override;
  30. property Image : TFPCustomImage read FImage write FImage;
  31. end;
  32. implementation
  33. constructor TFPImageCanvas.create (AnImage : TFPCustomImage);
  34. begin
  35. inherited Create;
  36. FImage := AnImage;
  37. end;
  38. destructor TFPImageCanvas.destroy;
  39. begin
  40. inherited destroy;
  41. end;
  42. procedure TFPImageCanvas.SetColor (x,y:integer; AValue:TFPColor);
  43. begin
  44. if (x >= 0) and (x < width) and (y >= 0) and (y < height) then
  45. FImage.Colors[x,y] := AValue;
  46. end;
  47. function TFPImageCanvas.GetColor (x,y:integer) : TFPColor;
  48. begin
  49. if (x >= 0) and (x < width) and (y >= 0) and (y < height) then
  50. result := FImage.Colors[x,y]
  51. else
  52. result := colTransparent;
  53. end;
  54. procedure TFPImageCanvas.SetHeight (AValue : integer);
  55. begin
  56. FImage.Height := AValue;
  57. end;
  58. function TFPImageCanvas.GetHeight : integer;
  59. begin
  60. result := FImage.Height;
  61. end;
  62. procedure TFPImageCanvas.SetWidth (AValue : integer);
  63. begin
  64. FImage.Width := AValue;
  65. end;
  66. function TFPImageCanvas.GetWidth : integer;
  67. begin
  68. result := FImage.Width;
  69. end;
  70. end.