home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D4 / COOLFORM.ZIP / CoolForm.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-15  |  8KB  |  315 lines
  1. unit CoolForm;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.     ExtCtrls ,dsgnintf;
  8.  
  9. type
  10.     TCoolForm = class;
  11.  
  12.     TRegionType = class(TPersistent)
  13.         public
  14.             Fregion:hrgn;
  15.             owner:TCoolForm;
  16.     end;
  17.  
  18.     TCoolForm = class(TImage)
  19.         private
  20.             Fregion : TRegionType;
  21.             FOrgRgn : PRgnData;
  22.             FOrgSize    : Integer;
  23.             // the dummy is necessary (or maybe not) as a public property for the writing of the
  24.             // mask into a stream (btter leyve it as it is, never touch a running system)
  25.             Dummy:TRegionType;
  26.             FDraggable:boolean;
  27.             procedure PictureChanged(Sender:TObject);
  28.             procedure ReadMask(Reader: TStream);
  29.             procedure WriteMask(Writer: TStream);
  30.             procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
  31.             procedure DefineProperties(Filer: TFiler);override;
  32.             procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  33.         protected
  34.             procedure SetRegion(Value:TRegionType);
  35.             procedure SetParent(Value:TWinControl); override;
  36.             procedure SetTop(Value:integer); virtual;
  37.             procedure SetLeft(Value:integer); virtual;
  38.             procedure Setwidth(Value:integer); virtual;
  39.             procedure SetHeight(Value:integer); virtual;
  40.             function GetRegion:TRegionType;
  41.             procedure size;
  42.         public
  43.             constructor Create(Aowner:TComponent); override;
  44.             destructor    Destroy; override;
  45.             property Mask2:TRegionType read Dummy write Dummy;
  46.             function LoadMaskFromFile (FileName: String): Boolean;
  47.         procedure RefreshRegion;
  48.         published
  49.             property Mask:TRegionType read GetRegion write SetRegion;
  50.             property Draggable:boolean read FDraggable write FDraggable default true;
  51.             property top write settop;
  52.             property left write setleft;
  53.             property width write setwidth;
  54.             property height write setheight;
  55.     end;
  56.  
  57. procedure Register;
  58.  
  59. implementation
  60. uses
  61.     MaskEditor;
  62.  
  63. procedure Register;
  64. begin
  65.     RegisterComponents ('Cool!', [TCoolForm]);
  66.     RegisterPropertyEditor (TypeInfo(TRegionType), TCoolForm, 'Mask', TCoolMaskEditor);
  67. end;
  68.  
  69.  
  70. // The next two procedures are there to ensure hat the component always sits in the top left edge of the window
  71. procedure TCoolForm.SetTop(Value:integer);
  72. begin
  73.     inherited top := 0;
  74. end;
  75.  
  76. procedure TCoolForm.SetLeft(Value:integer);
  77. begin
  78.     inherited left := 0;
  79. end;
  80.  
  81. procedure TCoolForm.RefreshRegion;
  82. begin
  83.     FRegion.FRegion := ExtCreateRegion (nil, FOrgSize, FOrgRgn^);
  84.     SetWindowRgn (parent.handle, FRegion.Fregion, true);
  85. end;
  86.  
  87.  
  88.  
  89. destructor TCoolForm.destroy;
  90. begin
  91.     If FOrgRgn <> Nil then
  92.         FreeMem (FOrgRgn, FOrgSize);
  93.  
  94.     if fregion.fregion <> 0 then deleteobject (fregion.fregion);
  95.     Dummy.Free;
  96.     FRegion.free;
  97.     inherited;
  98. end;
  99.  
  100. constructor TCoolForm.create(Aowner:TComponent);
  101. begin
  102.     inherited;
  103.     // make it occupy all of the form
  104.     Align := alClient;
  105.     Fregion := TRegionType.Create;
  106.     Dummy := TRegionType.Create;
  107.     Fregion.Fregion := 0;
  108.     Fregion.owner := self;
  109.     Picture.OnChange := PictureChanged;
  110.     // if draggable is false, it will be overwritten later by delphi`s runtime component loader
  111.     Draggable := true;
  112. end;
  113.  
  114. procedure TCoolForm.PictureChanged(Sender:TObject);
  115. begin
  116.     if (parent <> nil) and (picture.bitmap <> nil) then
  117.     begin
  118.         // resize the form to fit the bitmap
  119. {        width:=picture.bitmap.Width;
  120.         height:=picture.bitmap.height;
  121.         parent.clientwidth:=picture.bitmap.Width;
  122.         parent.clientheight:=picture.bitmap.height;
  123. }    end;
  124.     if Fregion.FRegion<>0 then
  125.     begin
  126.         // if somehow there`s a region already, delete it
  127.         deleteObject (FRegion.FRegion);
  128.         FRegion.Fregion := 0;
  129.     end;
  130. end;
  131.  
  132. function TCoolForm.GetRegion:TRegionType;
  133. begin
  134.     result := FRegion;
  135. end;
  136.  
  137. procedure TCoolForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  138. begin
  139.     // if dragging is on, start the dragging process
  140.     If button = mbleft then
  141.     begin
  142.         releasecapture;
  143.         TWincontrol (Parent).perform (WM_syscommand, $F012, 0);
  144.     end;
  145. end;
  146.  
  147. // This is used by delphi`s component streaming system
  148. // it is called whenever delphi reads the componnt from the .dfm
  149. procedure TCoolForm.ReadMask(Reader: TStream);
  150. begin
  151.     // read the size of the region data to come
  152.     reader.read (FOrgSize, 4);
  153.     if FOrgSize <> 0 then
  154.     begin
  155.         // if we have region data, allocate memory for it
  156.         getmem (FOrgRgn, FOrgSize);
  157.         // read the data
  158.         reader.read (FOrgRgn^, FOrgSize);
  159.         // create the region
  160.         FRegion.FRegion := ExtCreateRegion (nil, FOrgSize, FOrgRgn^);
  161.         if not (csDesigning in ComponentState) and (FRegion.FRegion <> 0) then
  162.             SetWindowRgn (parent.handle, FRegion.Fregion, true);
  163.         // dispose of the memory
  164.     end else fregion.fregion := 0;
  165. end;
  166.  
  167.  
  168. // This is pretty much the same stuff as above. Only it`s written this time
  169. procedure TCoolForm.WriteMask(Writer: TStream);
  170. var
  171.     size        : integer;
  172.     rgndata    : pRGNData;
  173.  
  174. begin
  175.     if (fregion.fregion<>0) then
  176.     begin
  177.         // get the region data`s size
  178.         size:=getregiondata (FRegion.FRegion, 0, nil);
  179.         getmem (rgndata,size);
  180.         // get the data itself
  181.         getregiondata (FRegion.FRegion, size, rgndata);
  182.         // write it
  183.         writer.write (size,sizeof (size));
  184.         writer.write (rgndata^, size);
  185.         freemem (rgndata, size);
  186.     end else
  187.     begin
  188.         // if there`s no region yet (from the mask editor), then write a size of zero
  189.         size := 0;
  190.         writer.write (size, sizeof (size));
  191.     end;
  192. end;
  193.  
  194.  
  195. // This tells Delphi to read the public property `Mask 2` from the stream,
  196. // That`s what we need the dummy for.
  197. procedure TCoolForm.DefineProperties(Filer: TFiler);
  198. begin
  199.     inherited DefineProperties(Filer);
  200.     // tell Delphi which methods to call when reading the property data from the stream
  201.     Filer.DefineBinaryProperty ('Mask2', ReadMask, WriteMask, true);
  202. end;
  203.  
  204.  
  205.  
  206. procedure TCoolForm.SetRegion(Value:TRegionType);
  207. begin
  208.     if Value <> nil then
  209.     begin
  210.         FRegion := Value;
  211.         // The owner is for the property editor to find the component
  212.         FRegion.owner := self;
  213.     end;
  214. end;
  215.  
  216.  
  217. procedure TCoolForm.SetParent(Value:TWinControl);
  218. begin
  219.     inherited;
  220.     if Value <> nil then
  221.         if not (Value is TWinControl) then
  222.         begin
  223.             raise Exception.Create ('Drop the CoolForm on a FORM!');
  224.         end else
  225.         with TWincontrol (Value) do
  226.         begin
  227.             if Value is TForm then TForm (Value).borderstyle := bsNone;
  228.         end;
  229.     top := 0;
  230.     left := 0;
  231. end;
  232.  
  233. procedure TCoolForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  234. begin
  235.     message.Result := 1;
  236. end;
  237.  
  238. function TCoolForm.LoadMaskFromFile (FileName: String): Boolean;
  239. var
  240.     reader : TFileStream;
  241.  
  242. begin
  243.     // read the size of the region data to come
  244.  
  245.     try
  246.         reader := TFileStream.Create (FileName, fmOpenRead);
  247.         reader.read (FOrgSize, 4);
  248.         if FOrgSize <> 0 then
  249.         begin
  250.             If ForgRgn <> Nil then
  251.                 FreeMem (FOrgRgn, FOrgSize);
  252.             // if we have region data, allocate memory for it
  253.             getmem(FOrgRgn, FOrgSize);
  254.             // read the data
  255.             reader.read (FOrgRgn^, FOrgSize);
  256.             // create the region
  257.             FRegion.FRegion:=ExtCreateRegion(nil,FOrgSize,FOrgRgn^);
  258.             // if runtime, set the region for the window... Tadaaa
  259.             if not (csDesigning in ComponentState) and (FRegion.FRegion <> 0) then
  260.             begin
  261.                 SetWindowRgn (parent.handle, FRegion.Fregion, true);
  262.             end;
  263.             // dispose of the memory
  264.         end else fregion.fregion := 0;
  265.          reader.free;
  266.         Result := True;
  267.     except
  268.         Result := False;
  269.     end;
  270.  
  271. end;
  272.  
  273. procedure TCoolForm.size;
  274. var
  275.     size        : integer;
  276.     rgndata    : pRGNData;
  277.     xf            : TXform;
  278.  
  279. begin
  280.     if (fregion.fregion<>0) then
  281.     begin
  282.         // get the region data`s size
  283.         size := getregiondata (FRegion.FRegion, 0, nil);
  284.         getmem (rgndata, size);
  285.         // get the data itself
  286.         getregiondata (FRegion.FRegion, size, rgndata);
  287.         // write it
  288.  
  289.         xf.eM11 := 1;//Width / Picture.Bitmap.Width;
  290.         xf.eM12 := 0;
  291.         xf.eM21 := 0;
  292.         xf.eM22 := 1;//Height / Picture.Bitmap.Height;
  293.         xf.eDx := 0;
  294.         xf.eDy := 0;
  295.         FRegion.FRegion := ExtCreateRegion (nil, size, rgndata^);
  296.  
  297.         if not (csDesigning in ComponentState) and (FRegion.FRegion <> 0) then
  298.             SetWindowRgn (parent.handle, FRegion.Fregion, true);
  299.     end;
  300. end;
  301.  
  302. procedure TCoolForm.Setwidth(Value:integer);
  303. begin
  304.     inherited Width := Value;
  305. //    Size;
  306. end;
  307.  
  308. procedure TCoolForm.SetHeight(Value:integer);
  309. begin
  310.     inherited Height := Value;
  311. //    Size;
  312. end;
  313.  
  314. end.
  315.