home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / delphi2.shr / UMASK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-01  |  9.5 KB  |  250 lines
  1. {  Project Mask.DPR Delphi 2.0 Demos
  2.  
  3.    Description:- Mask.Dpr Project:-
  4.  
  5.    Demonstrates the use of:
  6.  
  7.    1) 'MaskCopy'
  8.    2) 'Init'
  9.  
  10.    Date of Origin: 17/04/96
  11.    Original Author: Andrew Hutchison
  12.    Modification History:
  13.  
  14.    Date        Person                            Change
  15.    ----------------------------------------------------
  16.    17/04/96    A Hutchison                       Created
  17.  
  18.    (c) Copyright Media Architects Inc. 1996.
  19.    All rights reserved.   No part of this program may be
  20.    photocopied, reproduced, translated to another programming
  21.    language or transported to any computer system without the
  22.    prior written consent of Media Architects Inc.}
  23.  
  24. unit UMask;
  25.  
  26. interface
  27.  
  28. uses
  29.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  30.   OleCtrls, ImageKnife32, Menus, Buttons, StdCtrls;
  31.  
  32. type
  33.   TForm1 = class(TForm)
  34.     GroupBox1: TGroupBox;
  35.     GroupBox2: TGroupBox;
  36.     GroupBox3: TGroupBox;
  37.     Composite: TSpeedButton;
  38.     Lighten: TSpeedButton;
  39.     Darken: TSpeedButton;
  40.     MainMenu1: TMainMenu;
  41.     File1: TMenuItem;
  42.     LoadSourceImage1: TMenuItem;
  43.     LoadMaskImage1: TMenuItem;
  44.     LoadDestinationImage1: TMenuItem;
  45.     N1: TMenuItem;
  46.     SaveDestinationAs1: TMenuItem;
  47.     N2: TMenuItem;
  48.     Exit1: TMenuItem;
  49.     PicbufSrc: TPicbuf;
  50.     PicbufMask: TPicbuf;
  51.     PicbufDest: TPicbuf;
  52.     OpenDialog: TOpenDialog;
  53.     procedure LoadImage(Sender: TObject);
  54.     procedure CompositeClick(Sender: TObject);
  55.     procedure FormCreate(Sender: TObject);
  56.     procedure LightenClick(Sender: TObject);
  57.     procedure DarkenClick(Sender: TObject);
  58.     procedure Exit1Click(Sender: TObject);
  59.     procedure SaveDestinationAs1Click(Sender: TObject);
  60.   private
  61.     { Private declarations }
  62.   public
  63.     { Public declarations }
  64.   end;
  65.  
  66. var
  67.   Form1: TForm1;
  68.  
  69. {See Below}
  70. function GetImageLocation:String;
  71. {See Below}
  72. function ValidFormat(FileName:String):Boolean;
  73.  
  74. implementation
  75.  
  76. {$R *.DFM}
  77.  
  78. {-------------------------------------------------------------------------------}
  79. {Set up Defaults Including Loading Default Sample Images.}
  80. procedure TForm1.FormCreate(Sender: TObject);
  81. begin
  82. Application.HintPause:=10;
  83. Application.HintColor:=clAqua;
  84.  
  85. {Set FileNames - uses GetImageLocation function - See Below}
  86. PicbufSrc.filename := GetImageLocation  + 'images\squirrel.bmp';
  87. PicbufMask.filename := GetImageLocation + 'images\sqcutout.bmp';
  88. PicbufDest.filename := GetImageLocation + 'images\balloon.bmp';
  89.  
  90. {Load Default Source Image if it exists}
  91. if FileExists(PicbufSrc.filename) then{Delphi function call - True if file exists}
  92. PicbufSrc.Load
  93. else
  94. MessageDlg('Cannot find Sample file [\images\squirrel.bmp].' +
  95. ' Users should manually load this Image into the Source Picture.', mtInformation,
  96. [mbOk], 0);
  97.  
  98. {Load Default Mask Image if it exists}
  99. if FileExists(PicbufSrc.filename) then{Delphi function call - True if file exists}
  100. PicbufMask.Load
  101. else
  102. MessageDlg('Cannot find Sample file [\images\sqcutout.bmp].' +
  103. ' Users should manually load this Image into the Mask Picture.', mtInformation,
  104. [mbOk], 0);
  105.  
  106. {Load Default Destination Image if it exists}
  107. if FileExists(PicbufSrc.filename) then{Delphi function call - True if file exists}
  108. PicbufDest.Load
  109. else
  110. MessageDlg('Cannot find Sample file [\images\ballons.bmp].' +
  111. ' Users should manually load this Image into the Destination Picture.', mtInformation,
  112. [mbOk], 0);
  113. end;
  114.  
  115.  
  116. {-------------------------------------------------------------------------------}
  117. {Load an Image into the correct picbuf control.  Please note the use of a single
  118. event handler for more that one menu item.  This saves multiple instances of
  119. identical code.  Each Menu Item for loading is linked to the event 'LoadImage'.
  120. To do this simply open the menu designer, add the Menu Items.  Go to the first
  121. Menu Item - just highlite it, do not double click it, and then using Object
  122. inspector, pick the Events Page for the Menu Item.  Locate the 'OnClick' heading,
  123. and type in the Name of the Handler you wish to call - in this case 'LoadImage'.
  124. You can then double click the Item, and you will see Delphi creates the 'LoadImage'
  125. handler for you.  To add other Menus to the same event, just highlite the one you
  126. wish to add, go to the events page, loacte the OnClick event, and using the drop
  127. down arrow options, pick the event handler you wish to link the menu to, again
  128. in this case 'LoadImage'.
  129.  
  130. The final step is to allocate a number to the 'TAG' prperty of each menu item so
  131. you can identify which Menu Item sent the Click, in this example we have used
  132. 0,1,2 for Load Source, Load Mask and Load Destination. }
  133. procedure TForm1.LoadImage(Sender: TObject);
  134. begin
  135. {Display Common Dialog}
  136. if OpenDialog.Execute then
  137.  begin
  138.  Application.ProcessMessages;                                          {Catch Up}
  139. {Make sure the Sender parameter is a 'TMenuItem' - in our Case it will be one of
  140. three. Either Load Source, Mask or Destination Image}
  141. With Sender as TMenuItem do
  142. Case Tag of               {Reference TAG value of the MenuItem sending the Click}
  143. 0:                                                        {Load Source Menu Item}
  144.   begin
  145.   PicbufSrc.Filename:=OpenDialog.FileName;                         {Set FileName}
  146.   PicbufSrc.Load;                                                    {Load Image}
  147.   end;
  148. 1:                                                          {Load Mask Menu Item}
  149.   begin
  150.   PicbufMask.Filename:=OpenDialog.FileName;                        {Set FileName}
  151.   PicbufMask.Load;                                                   {Load Image}
  152.   end;
  153. 2:                                                   {Load Destination Menu Item}
  154.   begin
  155.   PicbufDest.Filename:=OpenDialog.FileName;                        {Set FileName}
  156.   PicbufDest.Load;                                                   {Load Image}
  157.   end;
  158. end;
  159. end;
  160. end;
  161.  
  162. {-------------------------------------------------------------------------------}
  163. {Composite Button - Carry out the Mask procedure. Users should make sure they
  164. trap errors for 'non valid' Images - The demo has no traps.}
  165. procedure TForm1.CompositeClick(Sender: TObject);
  166. begin
  167. PicbufDest.MaskCopy(PicbufSrc.OLEOBJECT, PicbufMask.OLEOBJECT);
  168. end;
  169.  
  170. {-------------------------------------------------------------------------------}
  171. {Lighten the Destination Image by using Masks}
  172. procedure TForm1.LightenClick(Sender: TObject);
  173. begin
  174. PicbufSrc.Init (24, PicbufDest.Xresolution, PicbufDest.Yresolution, RGB(255, 255, 255));
  175. PicbufMask.Init (24, PicbufDest.Xresolution, PicbufDest.Yresolution, RGB(75, 75, 75));
  176. CompositeClick(Sender);           {Call the Same code used by 'composite' Button}
  177. end;
  178.  
  179. {-------------------------------------------------------------------------------}
  180. {Darken the Destination Image by Using Masks}
  181. procedure TForm1.DarkenClick(Sender: TObject);
  182. begin
  183. PicbufSrc.Init (24, PicbufDest.Xresolution, PicbufDest.Yresolution, RGB(0, 0, 0));
  184. PicbufMask.Init (24, PicbufDest.Xresolution, PicbufDest.Yresolution, RGB(75, 75, 75));
  185. CompositeClick(Sender);           {Call the Same code used by 'composite' Button}
  186. end;
  187.  
  188. {-------------------------------------------------------------------------------}
  189. {Exit Application}
  190. procedure TForm1.Exit1Click(Sender: TObject);
  191. begin
  192. Halt;
  193. end;
  194.  
  195. {-------------------------------------------------------------------------------}
  196. {Save Image based on file extension}
  197. procedure TForm1.SaveDestinationAs1Click(Sender: TObject);
  198. begin
  199. if OpenDialog.Execute then
  200. begin
  201. PicbufDest.FileName:=OpenDialog.Filename;
  202. {Check to see a Valid filename exists - See function Below}
  203. if ValidFormat(PicbufDest.FileName) then      {Pass the fileName to the function}
  204. PicbufDest.Store                                                  {Save if Valid}
  205. else
  206. MessageDlg('Your File Extension is Not Valid.', mtInformation, [mbOk], 0);
  207. end;
  208. end;
  209.  
  210. {-------------------------------------------------------------------------------)
  211. {Get Path of Default files:-
  212. Basically the functions gets the path name of the EXE location, strips of the last
  213. directory, ready for use - only applicable to this Demo. See Delphi on-line help}
  214. function GetImageLocation:String;
  215. Var
  216. Temp:String;
  217. DelphiLocation:Integer;
  218. begin
  219. Temp := ExtractFileDir(Application.exename);               {Get full path of EXE}
  220. Temp := UpperCase(Temp);                             {Make Sure it is upper Case}
  221. DelphiLocation := Pos('\DELPHI2',Temp);
  222. Delete(Temp,DelphiLocation,length('\DELPHI2'));         {Strip of last Directory}
  223. Result:=Temp + '\';                                         {Add the Missing '\'}
  224. end;
  225.  
  226.  
  227. {-------------------------------------------------------------------------------}
  228. { This function simply checks to see if any one of the listed ImageKnife formats
  229. exist in the filename passed to the function. If it does then the function
  230. evaluates to true - Note this is the RESULT of the function.}
  231. function ValidFormat(FileName:String):Boolean;
  232. Var
  233. Temp:String;
  234. begin
  235. Temp := UpperCase(Filename);{Convert FileName to Upper Case}
  236. Result:=False;{Default result if no recognised match is found - *.*}
  237. if Pos('.TIF', Temp ) > 0 then Result:= True;           {for Pos see Delphi Help}
  238. if Pos('.TGA', Temp ) > 0 then Result:= True;
  239. if Pos('.BMP', Temp ) > 0 then Result:= True;
  240. if Pos('.GIF', Temp ) > 0 then Result:= True;
  241. if Pos('.DIB', Temp ) > 0 then Result:= True;
  242. if Pos('.PCX', Temp ) > 0 then Result:= True;
  243. if Pos('.JPG', Temp ) > 0 then Result:= True;
  244. if Pos('.MSP', Temp ) > 0 then Result:= True;
  245. if Pos('.FIF', Temp ) > 0 then Result:= True;
  246. if Pos('.PNG', Temp ) > 0 then Result:= True;
  247. end;
  248.  
  249. end.
  250.