home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / gfvcl13 / p_form.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  2.4 KB  |  81 lines
  1. unit P_form;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, Gfvcl;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     GradientFill1: TGradientFill;
  12.     procedure FormCreate(Sender: TObject);
  13.   private
  14.     { Private declarations }
  15.     FClientInstance,
  16.     FPrevClientProc : TFarProc;
  17.     procedure ClientWndProc(VAR Message: TMessage);
  18.   public
  19.     { Public declarations }
  20.   end;
  21.  
  22. var
  23.   Form1: TForm1;
  24.  
  25. implementation
  26.  
  27. {$R *.DFM}
  28.  
  29. procedure TForm1.ClientWndProc(VAR Message: TMessage);
  30. var
  31.   MyDC : hDC;
  32.   Ro, Co : Word;
  33. begin
  34.   with Message do
  35.     case Msg of
  36.       WM_ERASEBKGND:
  37.         begin
  38.           MyDC := TWMEraseBkGnd(Message).DC;
  39.           { Set Canvas's palette to the new one }
  40.           SelectPalette(MyDC, GradientFill1.PaletteHandle, False);
  41.           { Make Canvas recognize the palette }
  42.           RealizePalette(MyDC);
  43.  
  44.           { This commented out code tiles the Gradient.  If the Parent is
  45.             resized, then the Gradient is tiled to fit the new size.  This
  46.             will cause a banding look if the form is sized larger than before }
  47.           { for Ro := 0 TO ClientHeight DIV GradientFill1.Picture.Height DO
  48.               for Co := 0 TO ClientWIDTH DIV GradientFill1.Picture.Width DO
  49.                 BitBlt(MyDC, Co*GradientFill1.Picture.Width, Ro*GradientFill1.Picture.Height,
  50.                   GradientFill1.Picture.Width, GradientFill1.Picture.Height,
  51.                   GradientFill1.Picture.Canvas.Handle, 0, 0, SRCCOPY);
  52.           }
  53.  
  54.  
  55.           { This line will stretch the Gradient to completely fill the
  56.             background when it is resized.
  57.           }
  58.           StretchBlt(MyDC, 0, 0, ClientWidth, ClientHeight,
  59.             GradientFill1.Picture.Canvas.Handle, 0, 0,
  60.             GradientFill1.Picture.Width, GradientFill1.Picture.Height,
  61.             SRCCOPY);
  62.           { Returns a result to Windows }
  63.           Result := 1;
  64.         end;
  65.     else
  66.       { Returns a result to Windows }
  67.       Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
  68.     end;
  69. end;
  70.  
  71.  
  72.  
  73. procedure TForm1.FormCreate(Sender: TObject);
  74. begin
  75.   FClientInstance := MakeObjectInstance(ClientWndProc);
  76.   FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  77.   SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
  78. end;
  79.  
  80. end.
  81.