Componentes/CDopping/CoolForm/CoolForm.pas

unit CoolForm;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	ExtCtrls ,dsgnintf;

type
	TCoolForm = class;

	TRegionType = class(TPersistent)
		public
			Fregion:hrgn;
			owner:TCoolForm;
	end;

	TCoolForm = class(TImage)
		private
			Fregion : TRegionType;
			FOrgRgn : PRgnData;
			FOrgSize	: Integer;
			// the dummy is necessary (or maybe not) as a public property for the writing of the
			// mask into a stream (btter leyve it as it is, never touch a running system)
			Dummy:TRegionType;
			FDraggable:boolean;
			procedure PictureChanged(Sender:TObject);
			procedure ReadMask(Reader: TStream);
			procedure WriteMask(Writer: TStream);
			procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
			procedure DefineProperties(Filer: TFiler);override;
			procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
		protected
			procedure SetRegion(Value:TRegionType);
			procedure SetParent(Value:TWinControl); override;
			procedure SetTop(Value:integer); virtual;
			procedure SetLeft(Value:integer); virtual;
			procedure Setwidth(Value:integer); virtual;
			procedure SetHeight(Value:integer); virtual;
			function GetRegion:TRegionType;
			procedure size;
		public
			constructor Create(Aowner:TComponent); override;
			destructor	Destroy; override;
			property Mask2:TRegionType read Dummy write Dummy;
			function LoadMaskFromFile (FileName: String): Boolean;
        procedure RefreshRegion;
		published
			property Mask:TRegionType read GetRegion write SetRegion;
			property Draggable:boolean read FDraggable write FDraggable default true;
			property top write settop;
			property left write setleft;
			property width write setwidth;
			property height write setheight;
	end;

procedure Register;

implementation
uses
	MaskEditor;

procedure Register;
begin
	RegisterComponents ('Cool!', [TCoolForm]);
	RegisterPropertyEditor (TypeInfo(TRegionType), TCoolForm, 'Mask', TCoolMaskEditor);
end;


// The next two procedures are there to ensure hat the component always sits in the top left edge of the window
procedure TCoolForm.SetTop(Value:integer);
begin
	inherited top := 0;
end;

procedure TCoolForm.SetLeft(Value:integer);
begin
	inherited left := 0;
end;

procedure TCoolForm.RefreshRegion;
begin
	FRegion.FRegion := ExtCreateRegion (nil, FOrgSize, FOrgRgn^);
	SetWindowRgn (parent.handle, FRegion.Fregion, true);
end;



destructor TCoolForm.destroy;
begin
	If FOrgRgn <> Nil then
		FreeMem (FOrgRgn, FOrgSize);

	if fregion.fregion <> 0 then deleteobject (fregion.fregion);
	Dummy.Free;
	FRegion.free;
	inherited;
end;

constructor TCoolForm.create(Aowner:TComponent);
begin
	inherited;
	// make it occupy all of the form
	Align := alClient;
	Fregion := TRegionType.Create;
	Dummy := TRegionType.Create;
	Fregion.Fregion := 0;
	Fregion.owner := self;
	Picture.OnChange := PictureChanged;
	// if draggable is false, it will be overwritten later by delphi`s runtime component loader
	Draggable := true;
end;

procedure TCoolForm.PictureChanged(Sender:TObject);
begin
	if (parent <> nil) and (picture.bitmap <> nil) then
	begin
		// resize the form to fit the bitmap
{		width:=picture.bitmap.Width;
		height:=picture.bitmap.height;
		parent.clientwidth:=picture.bitmap.Width;
		parent.clientheight:=picture.bitmap.height;
}	end;
	if Fregion.FRegion<>0 then
	begin
		// if somehow there`s a region already, delete it
		deleteObject (FRegion.FRegion);
		FRegion.Fregion := 0;
	end;
end;

function TCoolForm.GetRegion:TRegionType;
begin
	result := FRegion;
end;

procedure TCoolForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	// if dragging is on, start the dragging process
	If button = mbleft then
	begin
		releasecapture;
		TWincontrol (Parent).perform (WM_syscommand, $F012, 0);
	end;
end;

// This is used by delphi`s component streaming system
// it is called whenever delphi reads the componnt from the .dfm
procedure TCoolForm.ReadMask(Reader: TStream);
begin
	// read the size of the region data to come
	reader.read (FOrgSize, 4);
	if FOrgSize <> 0 then
	begin
		// if we have region data, allocate memory for it
		getmem (FOrgRgn, FOrgSize);
		// read the data
		reader.read (FOrgRgn^, FOrgSize);
		// create the region
		FRegion.FRegion := ExtCreateRegion (nil, FOrgSize, FOrgRgn^);
		if not (csDesigning in ComponentState) and (FRegion.FRegion <> 0) then
			SetWindowRgn (parent.handle, FRegion.Fregion, true);
		// dispose of the memory
	end else fregion.fregion := 0;
end;


// This is pretty much the same stuff as above. Only it`s written this time
procedure TCoolForm.WriteMask(Writer: TStream);
var
	size		: integer;
	rgndata	: pRGNData;

begin
	if (fregion.fregion<>0) then
	begin
		// get the region data`s size
		size:=getregiondata (FRegion.FRegion, 0, nil);
		getmem (rgndata,size);
		// get the data itself
		getregiondata (FRegion.FRegion, size, rgndata);
		// write it
		writer.write (size,sizeof (size));
		writer.write (rgndata^, size);
		freemem (rgndata, size);
	end else
	begin
		// if there`s no region yet (from the mask editor), then write a size of zero
		size := 0;
		writer.write (size, sizeof (size));
	end;
end;


// This tells Delphi to read the public property `Mask 2` from the stream,
// That`s what we need the dummy for.
procedure TCoolForm.DefineProperties(Filer: TFiler);
begin
	inherited DefineProperties(Filer);
	// tell Delphi which methods to call when reading the property data from the stream
	Filer.DefineBinaryProperty ('Mask2', ReadMask, WriteMask, true);
end;



procedure TCoolForm.SetRegion(Value:TRegionType);
begin
	if Value <> nil then
	begin
		FRegion := Value;
		// The owner is for the property editor to find the component
		FRegion.owner := self;
	end;
end;


procedure TCoolForm.SetParent(Value:TWinControl);
begin
	inherited;
	if Value <> nil then
		if not (Value is TWinControl) then
		begin
			raise Exception.Create ('Drop the CoolForm on a FORM!');
		end else
		with TWincontrol (Value) do
		begin
			if Value is TForm then TForm (Value).borderstyle := bsNone;
		end;
	top := 0;
	left := 0;
end;

procedure TCoolForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
	message.Result := 1;
end;

function TCoolForm.LoadMaskFromFile (FileName: String): Boolean;
var
	reader : TFileStream;

begin
	// read the size of the region data to come

	try
		reader := TFileStream.Create (FileName, fmOpenRead);
		reader.read (FOrgSize, 4);
		if FOrgSize <> 0 then
		begin
			If ForgRgn <> Nil then
				FreeMem (FOrgRgn, FOrgSize);
			// if we have region data, allocate memory for it
			getmem(FOrgRgn, FOrgSize);
			// read the data
			reader.read (FOrgRgn^, FOrgSize);
			// create the region
			FRegion.FRegion:=ExtCreateRegion(nil,FOrgSize,FOrgRgn^);
			// if runtime, set the region for the window... Tadaaa
			if not (csDesigning in ComponentState) and (FRegion.FRegion <> 0) then
			begin
				SetWindowRgn (parent.handle, FRegion.Fregion, true);
			end;
			// dispose of the memory
		end else fregion.fregion := 0;
		 reader.free;
		Result := True;
	except
		Result := False;
	end;

end;

procedure TCoolForm.size;
var
	size		: integer;
	rgndata	: pRGNData;
	xf			: TXform;

begin
	if (fregion.fregion<>0) then
	begin
		// get the region data`s size
		size := getregiondata (FRegion.FRegion, 0, nil);
		getmem (rgndata, size);
		// get the data itself
		getregiondata (FRegion.FRegion, size, rgndata);
		// write it

		xf.eM11 := 1;//Width / Picture.Bitmap.Width;
		xf.eM12 := 0;
		xf.eM21 := 0;
		xf.eM22 := 1;//Height / Picture.Bitmap.Height;
		xf.eDx := 0;
		xf.eDy := 0;
		FRegion.FRegion := ExtCreateRegion (nil, size, rgndata^);

		if not (csDesigning in ComponentState) and (FRegion.FRegion <> 0) then
			SetWindowRgn (parent.handle, FRegion.Fregion, true);
	end;
end;

procedure TCoolForm.Setwidth(Value:integer);
begin
	inherited Width := Value;
//	Size;
end;

procedure TCoolForm.SetHeight(Value:integer);
begin
	inherited Height := Value;
//	Size;
end;

end.