home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Help / Examples / Bitmap / BMPFORMU.PAS < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  3KB  |  127 lines
  1. unit bmpformu;
  2.  
  3. // A TBitmap is an encapsulation of the windows BITMAP and PALETTE which
  4. // manages realizing of the palette automatically.
  5. //
  6. // The bitmap can be loaded from a .BMP file (LoadFromFile method) or a
  7. // resource (LoadFromResourceName or LoadFromResourceID method) and saved
  8. // back to a file (SaveToFile method).  It can be drawn on a canvas by
  9. // using the TCanvas' Draw or StretchDraw method.  The size of the bitmap
  10. // can be determined by using the Height and Width properties of TBitmap.
  11. //
  12. // The example below illustrates the use of the following:
  13. //
  14. // TBitmap, Palette, LoadFromFile, Draw, Height, Width
  15.  
  16. // Be sure that a small bitmap file named bor6.bmp is present in the same
  17. // directory as the .exe file.
  18.  
  19. // Disclaimer: This is an example of using TBitmaps and is not intended to
  20. // be an efficient method of tiling a form.
  21.  
  22. interface
  23.  
  24. uses
  25.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  26.   StdCtrls;
  27.  
  28. type
  29.   TBmpForm = class(TForm)
  30.     Button1: TButton;
  31.     procedure FormDestroy(Sender: TObject);
  32.     procedure FormPaint(Sender: TObject);
  33.     procedure Button1Click(Sender: TObject);
  34.     procedure FormCreate(Sender: TObject);
  35.   private
  36.     { Private declarations }
  37.     Bitmap: TBitmap;
  38.     procedure ScrambleBitmap;
  39.     procedure WMEraseBkgnd(var m: TWMEraseBkgnd); message WM_ERASEBKGND;
  40.   public
  41.     { Public declarations }
  42.   end;
  43.  
  44. var
  45.   BmpForm: TBmpForm;
  46.  
  47. implementation
  48.  
  49.  
  50. {$R *.DFM}
  51.  
  52.  
  53. procedure TBmpForm.FormCreate(Sender: TObject);
  54. begin
  55.   Bitmap := TBitmap.Create;
  56.   Bitmap.LoadFromFile('bor6.bmp');
  57. end;
  58.  
  59. procedure TBmpForm.FormDestroy(Sender: TObject);
  60. begin
  61.   Bitmap.Free;
  62. end;
  63.  
  64. // since we're going to be painting the whole form, handling this
  65. // message will suppress the uneccessary repainting of the background
  66. // which can result in flicker.
  67. procedure TBmpform.WMEraseBkgnd(var m : TWMEraseBkgnd);
  68. begin
  69.   m.Result := LRESULT(False);
  70. end;
  71.  
  72. procedure TBmpForm.FormPaint(Sender: TObject);
  73. var
  74.   x, y: Integer;
  75. begin
  76.   y := 0;
  77.   while y < Height do
  78.   begin
  79.     x := 0;
  80.     while x < Width do
  81.     begin
  82.       Canvas.Draw(x, y, Bitmap);
  83.       x := x + Bitmap.Width;
  84.     end;
  85.     y := y + Bitmap.Height;
  86.   end;
  87. end;
  88.  
  89. procedure TBmpForm.Button1Click(Sender: TObject);
  90. begin
  91.   ScrambleBitmap;
  92.   Invalidate;
  93. end;
  94.  
  95.  
  96. //
  97. // scrambling the bitmap is easy when it's has 256 colors:
  98. // we just need to change each of the color in the palette
  99. // to some other value.
  100. //
  101. procedure TBmpForm.ScrambleBitmap;
  102. var
  103.   pal: PLogPalette;
  104.   hpal: HPALETTE;
  105.   i: Integer;
  106. begin
  107.   pal := nil;
  108.   try
  109.     GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);
  110.     pal.palVersion := $300;
  111.     pal.palNumEntries := 256;
  112.     for i := 0 to 255 do
  113.     begin
  114.       pal.palPalEntry[i].peRed := Random(255);
  115.       pal.palPalEntry[i].peGreen := Random(255);
  116.       pal.palPalEntry[i].peBlue := Random(255);
  117.     end;
  118.     hpal := CreatePalette(pal^);
  119.     if hpal <> 0 then
  120.       Bitmap.Palette := hpal;
  121.   finally
  122.     FreeMem(pal);
  123.   end;
  124. end;
  125.  
  126. end.
  127.