unit1.pas

BmpRgn is a *FREEWARE* unit that allows you to create forms with transparent areas based on a bitm

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ExtCtrls, StdCtrls, ExtDlgs, Menus;


type
  TForm1 = class(TForm)
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    ListBox1: TListBox;
    Label1: TLabel;
    OpenPictureDialog1: TOpenPictureDialog;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
  private
    { Private declarations }
    procedure WMEraseBkGnd( Var Msg: TWMEraseBkGnd ); message WM_ERASEBKGND;
    procedure WMNCHitTest( Var msg: TWMNCHitTest ); message WM_NCHITTEST;
  public
    { Public declarations }
    procedure SetTheRegion;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses BmpRgn;



procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Picture.Bitmap.LoadFromResourceID( hInstance, 100);
  SetTheRegion;
end;


procedure TForm1.FormShow(Sender: TObject);
begin
  Listbox1.ItemIndex := 0;
end;


procedure TForm1.SetTheRegion;
var HR: HRGN;
begin
  HR := BmpToRegion( Self, Image1.Picture.Bitmap);
  SetWindowRgn( handle, HR, true);
  Invalidate;
end;



// This routine takes care of drawing the bitmap on the form.
procedure TForm1.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
var Brush: TBrush;
begin
  Brush := TBrush.Create;
  Brush.Color := Color;
  FillRect( Msg.DC, ClientRect, Brush.Handle);
  Brush.Free;
  with Image1.Picture.Bitmap do
    BitBlt( Msg.DC, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
  Msg.Result := 1;
end;



// This routine takes care of letting the user move the form
// around on the desktop.
procedure TForm1.WMNCHitTest( var msg: TWMNCHitTest );
var
  i: integer;
  p: TPoint;
  AControl: TControl;
  MouseOnControl: boolean;
begin
  inherited;
  if msg.result = HTCLIENT then begin
    p.x := msg.XPos;
    p.y := msg.YPos;
    p := ScreenToClient( p);
    MouseOnControl := false;
    for i := 0 to ControlCount-1 do begin
      if not MouseOnControl
      then begin
        AControl := Controls[i];
        if ((AControl is TWinControl) or (AControl is TGraphicControl))
          and (AControl.Visible)
        then MouseOnControl := PtInRect( AControl.BoundsRect, p);
      end
      else
        break;
    end;
    if (not MouseOnControl) then msg.Result := HTCAPTION;
  end;
end;


// This is an example of how to toggle between the normal
// window and the bitmap region window.
procedure TForm1.SpeedButton1Click(Sender: TObject);
var HR: HRGN; n: integer;
begin

  if WindowState = wsMaximized then WindowState := wsNormal;
  HR := CreateRectRgn(0,0,1,1);
  n := GetWindowRgn( handle, HR);
  DeleteObject( HR);

  if n = 0 then
    SetTheRegion
  else
    SetWindowRgn( handle, 0, true);

end;


// If you're going to hide the title bar, it's a good idea to provide
// a button to close the form with. This component makes sure that
// the user can close the form even if the title bar isn't visible.
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  Close;
end;


// You can select one of the bitmaps that are loaded as resources,
// or you can try one of your own.
procedure TForm1.ListBox1DblClick(Sender: TObject);
var AppPath: string; n: integer; s: string;
begin
  n := ListBox1.ItemIndex;
  if n < 4 then
    Image1.Picture.Bitmap.LoadFromResourceID( hInstance, 100+n)
  else begin
    with OpenPictureDialog1 do
      if Execute
      then Image1.Picture.Bitmap.LoadFromFile( filename);
  end;
  SetTheRegion;
end;


end.