home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D4 / COOLFORM.ZIP / maskgenerator.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-15  |  7.4 KB  |  262 lines
  1. unit maskgenerator;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.     StdCtrls, ComCtrls, Buttons, ExtCtrls, CoolForm, ExtDlgs;
  8.  
  9. type
  10.     TFormMaskGenerator = class(TForm)
  11.         SpeedButton1: TSpeedButton;
  12.         SpeedButton2: TSpeedButton;
  13.         SpeedButton3: TSpeedButton;
  14.         Panel1: TPanel;
  15.         CoolForm1: TCoolForm;
  16.         Image1: TImage;
  17.     OpenDialog1: TOpenPictureDialog;
  18.     SpeedButton4: TSpeedButton;
  19.     SaveDialog1: TSaveDialog;
  20.         procedure SpeedButton1Click(Sender: TObject);
  21.         procedure SpeedButton2Click(Sender: TObject);
  22.         procedure SpeedButton3Click(Sender: TObject);
  23.         procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  24.         procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  25.         procedure BitMapChange(Sender:TObject);
  26.         procedure FormCreate(Sender: TObject);
  27.     procedure SpeedButton4Click(Sender: TObject);
  28.     private
  29.             oldleft,oldtop:integer;
  30.          generating:boolean;
  31.     public
  32.          OriginalRegionSize:integer;
  33.         OriginalRegiondata:pRGNData;
  34.          rgn1:hrgn;
  35.         procedure SaveOriginalRegionData;
  36.          destructor destroy; override;
  37.     end;
  38.  
  39. var
  40.     FormMaskGenerator: TFormMaskGenerator;
  41.  
  42.  
  43. implementation
  44.  
  45. {$R *.DFM}
  46.  
  47. procedure TFormMaskGenerator.SpeedButton1Click(Sender: TObject);
  48. begin
  49.     if Opendialog1.Execute then image1.Picture.bitmap.LoadFromFile(opendialog1.filename);
  50. end;
  51.  
  52.  
  53. // This method is necessary to react to changes in the size of the bitmap
  54. procedure TFormMaskGenerator.BitMapChange(Sender:TObject);
  55. var
  56.     tr2,temprgn:hrgn;
  57.     x:pxform;
  58. begin
  59.     if not generating then
  60.     begin
  61.         // This is the transformation matrix to be used in the region generating process
  62.         // will be used in future releases
  63.         x:=new(pxform);
  64.         x.eM11:=1;
  65.         x.eM12:=0;
  66.         x.eM21:=0;
  67.         x.eM22:=1;
  68.         x.eDx:=-oldleft;
  69.         x.eDy:=-oldtop;
  70.  
  71.         // the original region is created (the generator form only)
  72.         temprgn:=ExtCreateRegion(x,originalRegionSize,OriginalRegionData^);
  73.         image1.width:=image1.picture.bitmap.width;
  74.         image1.height:=image1.picture.bitmap.height;
  75.         clientwidth:=image1.Left+image1.Width;
  76.         clientHeight:=image1.Top+image1.Height;
  77.      if clientwidth<=150 then ClientWidth:=150;
  78.      if clientHeight<=150 then ClientHeight:=150;
  79.  
  80.         // a region for the bitmap is created
  81.         tr2:=CreateRectRgn(image1.left,image1.top,image1.left+image1.width,image1.top+image1.height);
  82.         // the two regions are combined
  83.         CombineRgn(temprgn,temprgn,tr2,RGN_OR);
  84.         // set the new region
  85.         DeleteObject(CoolForm1.Mask.fregion);
  86.         CoolForm1.Mask.Fregion:=tempRgn;
  87.         SetWindowRgn(handle,temprgn,true);
  88.         // clean up
  89.         DeleteObject(tr2);
  90.         image1.repaint;
  91.         dispose(x);
  92.     end;
  93. end;
  94.  
  95.  
  96. // this method is called by the Propertyeditor to backup the maskgenerator`s mask generated at design-time
  97. procedure TFormMaskGenerator.SaveOriginalRegionData;
  98. begin
  99.     // clean up
  100.     if OriginalRegionData<>nil then
  101.     begin
  102.         freemem(OriginalRegionData);
  103.         OriginalRegionData:=nil;
  104.     end;
  105.     // save original mask information
  106.     oldleft:=left;
  107.     oldtop:=top;
  108.     OriginalRegionsize:=GetRegionData(CoolForm1.Mask.Fregion,0,nil);
  109.     getmem(OriginalRegionData,OriginalRegionsize);
  110.     getregiondata(CoolForm1.Mask.FRegion,OriginalRegionsize,OriginalRegiondata);
  111. end;
  112.  
  113. destructor TFormMaskGenerator.destroy;
  114. begin
  115.         // clean up
  116.     if OriginalRegionData<>nil then
  117.     begin
  118.         freemem(originalregiondata);
  119.     end;
  120.     OriginalRegionData:=nil;
  121.     inherited;
  122. end;
  123.  
  124.  
  125. procedure TFormMaskGenerator.SpeedButton2Click(Sender: TObject);
  126. begin
  127.     close;
  128. end;
  129.  
  130. // This is called when the User clicks the OK Button
  131. procedure TFormMaskGenerator.SpeedButton3Click(Sender: TObject);
  132. var
  133. //    stream                        : TFileStream;
  134.     size                            : integer;
  135. //    rgndata                        : pRGNData;
  136.     x,y                            : integer;
  137.     transparentcolor            : tcolor;
  138.     rgn2                            : hrgn;
  139.     startx,endx                    : integer;
  140.     R                                : TRect;
  141.  
  142. begin
  143.   if Panel1.Color =  clNone then
  144.      Begin
  145.        ShowMessage('You must select the colour to be masked out.'#13+
  146.                    'Click on the mask colour in the bitmap. '#13 +
  147.                    '(It will appear in the square to the right of the load button).');
  148.        Exit;
  149.      End;
  150.     generating:=true;
  151.     // clean up
  152.     if rgn1<>0 then deleteObject(rgn1);
  153.     rgn1 := 0;
  154.     // set the transparent color
  155.     transparentcolor:=Panel1.color;
  156.     // if necessary, load another mask (don`t know why again... should be redundant)
  157.     if opendialog1.filename<>'' then image1.picture.bitmap.loadfromfile(opendialog1.filename);
  158.     
  159.     // for every line do...
  160.     for y := 0 to image1.Picture.Height-1 do
  161.     begin
  162.         // don`t look as if we were locked up
  163.         Application.ProcessMessages;
  164.         x:=0;
  165.         endx:=x;
  166.         // no flicker
  167.         lockWindowUpdate(FormMaskGenerator.handle);
  168.         repeat
  169.             // look for the beginning of a stretch of non-transparent pixels
  170.             while (image1.picture.bitmap.canvas.pixels[x,y]=transparentcolor) and (x<=image1.picture.width) do
  171.             inc(x);
  172.             startx:=x;
  173.             // paint the pixels up to here black
  174.             for size:=endx to startx do image1.picture.bitmap.canvas.pixels[size,y]:=image1.picture.bitmap.canvas.pixels[size,y] xor $FFFFFF;
  175.             // look for the end of a stretch of non-transparent pixels
  176.         inc(x);
  177.             while (image1.picture.bitmap.canvas.pixels[x,y]<>transparentcolor) and (x<=image1.picture.width) do
  178.             inc(x);
  179.             endx:=x;
  180.             // do we have some pixels?
  181.             if startx<>image1.Picture.Width then
  182.             begin
  183.                 if endx= image1.Picture.Width then dec(endx);
  184.                 // do we have a region already?
  185.                 if rgn1 = 0 then
  186.                 begin
  187.                     // Create a region to start with
  188.                     rgn1:=createrectrgn(startx+1,y,endx,y+1);
  189.                 end else
  190.                 begin
  191.                     // Add to the existing region
  192.                     rgn2:=createrectrgn(startx+1,y,endx,y+1);
  193.                     if rgn2<>0 then combinergn(rgn1,rgn1,rgn2,RGN_OR);
  194.                     deleteobject(rgn2);
  195.                 end;
  196.                 // Paint the pixels white
  197.                 for size:=startx to endx do image1.picture.bitmap.canvas.pixels[size,y]:=image1.picture.bitmap.canvas.pixels[size,y] xor $FFFFFF;
  198.             end;
  199.         until x>=image1.picture.width-1;
  200.         // flicker on
  201.         lockwindowUpdate(0);
  202.         // tell windows to repaint only the line of the bitmap we just processed
  203.         R.top:=image1.top+y;
  204.         r.Bottom:=image1.top+y+1;
  205.         r.left:=image1.left;
  206.         r.right:=image1.left+image1.Width;
  207.         invalidaterect(formmaskgenerator.handle,@R,false);
  208.         formmaskgenerator.Update;
  209.     end;
  210.     generating:=false;
  211.     close;
  212. end;
  213.  
  214.  
  215. procedure TFormMaskGenerator.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  216. begin
  217.     if ssLeft in Shift then
  218.     begin
  219.         panel1.color:=image1.picture.bitmap.canvas.pixels[x,y];
  220.     end;
  221. end;
  222.  
  223.  
  224. procedure TFormMaskGenerator.Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  225. begin
  226.     panel1.color:=image1.picture.bitmap.canvas.pixels[x,y];
  227. end;
  228.  
  229.  
  230. procedure TFormMaskGenerator.FormCreate(Sender: TObject);
  231. begin
  232.     image1.picture.OnChange:=BitMapChange;
  233. end;
  234.  
  235. procedure TFormMaskGenerator.SpeedButton4Click(Sender: TObject);
  236. var
  237.     size            : integer;
  238.     rgndata        : pRGNData;
  239.     writer        : TFileStream;
  240.  
  241. begin
  242.     If SaveDialog1.Execute then
  243.     begin
  244.         if (rgn1<>0) then
  245.         begin
  246.             writer :=TFileStream.Create (SaveDialog1.Filename, fmCreate);
  247.             // get the region data`s size
  248.             size:=getregiondata (rgn1, 0, nil);
  249.             getmem (rgndata, size);
  250.             // get the data itself
  251.             getregiondata(rgn1, size, rgndata);
  252.             // write it
  253.             writer.write (size, sizeof(size));
  254.             writer.write (rgndata^, size);
  255.             freemem(rgndata, size);
  256.             writer.Free;            
  257.         end;
  258.     end;
  259. end;
  260.  
  261. end.
  262.