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.