home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / delphi2.shr / UMATRIX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-01  |  13.7 KB  |  409 lines
  1. {  Project Matrix.DPR Delphi 2.0 Demos
  2.  
  3.    Description:- Matrix.Dpr Project:-
  4.  
  5.    Demonstrates the use of:
  6.  
  7.    1) 'Soften'
  8.    2) 'Sharpen'
  9.    3) 'ExtractEdges'
  10.    4) 'Blur'
  11.    5) 'MatrixFilter'
  12.  
  13.    Date of Origin: 17/04/96
  14.    Original Author: Andrew Hutchison
  15.    Modification History:
  16.  
  17.    Date        Person                            Change
  18.    ----------------------------------------------------
  19.    17/04/96    A Hutchison                       Created
  20.  
  21.    (c) Copyright Media Architects Inc. 1996.
  22.    All rights reserved.   No part of this program may be
  23.    photocopied, reproduced, translated to another programming
  24.    language or transported to any computer system without the
  25.    prior written consent of Media Architects Inc.}
  26.  
  27. unit UMatrix;
  28.  
  29. interface
  30.  
  31. uses
  32.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  33.   ExtCtrls, OleCtrls, ImageKnife32, Menus, ComCtrls, Tabnotbk, StdCtrls,
  34.   Spin, Buttons;
  35.  
  36. type
  37.   TForm1 = class(TForm)
  38.     MainMenu1: TMainMenu;
  39.     File1: TMenuItem;
  40.     LoadImage: TMenuItem;
  41.     SaveImageAs1: TMenuItem;
  42.     N1: TMenuItem;
  43.     Exit1: TMenuItem;
  44.     OpenDialog: TOpenDialog;
  45.     PicbufVisible: TPicbuf;
  46.     Bevel1: TBevel;
  47.     MatrixPage: TTabbedNotebook;
  48.     Element00: TSpinEdit;
  49.     Element10: TSpinEdit;
  50.     Element11: TSpinEdit;
  51.     Element20: TSpinEdit;
  52.     Element21: TSpinEdit;
  53.     Element22: TSpinEdit;
  54.     Element01: TSpinEdit;
  55.     Element02: TSpinEdit;
  56.     Element12: TSpinEdit;
  57.     Scale: TSpinEdit;
  58.     Norm: TSpinEdit;
  59.     Offset: TSpinEdit;
  60.     RadioGroup: TRadioGroup;
  61.     ScrollBar: TScrollBar;
  62.     Process: TSpeedButton;
  63.     Undo: TSpeedButton;
  64.     PicbufEdit: TPicbuf;
  65.     PicbufOriginal: TPicbuf;
  66.     Element500: TSpinEdit;
  67.     Element510: TSpinEdit;
  68.     Element514: TSpinEdit;
  69.     Element521: TSpinEdit;
  70.     Element523: TSpinEdit;
  71.     Element530: TSpinEdit;
  72.     Element502: TSpinEdit;
  73.     Element503: TSpinEdit;
  74.     Element512: TSpinEdit;
  75.     Element513: TSpinEdit;
  76.     Element504: TSpinEdit;
  77.     Element524: TSpinEdit;
  78.     Element532: TSpinEdit;
  79.     Element531: TSpinEdit;
  80.     Element522: TSpinEdit;
  81.     Element520: TSpinEdit;
  82.     Element511: TSpinEdit;
  83.     Element501: TSpinEdit;
  84.     Element533: TSpinEdit;
  85.     Element534: TSpinEdit;
  86.     Element540: TSpinEdit;
  87.     Element541: TSpinEdit;
  88.     Element544: TSpinEdit;
  89.     Element542: TSpinEdit;
  90.     Element543: TSpinEdit;
  91.     Scale5: TSpinEdit;
  92.     Norm5: TSpinEdit;
  93.     Offset5: TSpinEdit;
  94.     Label1: TLabel;
  95.     Label2: TLabel;
  96.     Label3: TLabel;
  97.     procedure SaveImageAs1Click(Sender: TObject);
  98.     procedure LoadImageClick(Sender: TObject);
  99.     procedure PicbufOriginalChange(Sender: TObject);
  100.     procedure PicbufEditChange(Sender: TObject);
  101.     procedure RadioGroupClick(Sender: TObject);
  102.     procedure ScrollBarChange(Sender: TObject);
  103.     procedure ProcessClick(Sender: TObject);
  104.     procedure Exit1Click(Sender: TObject);
  105.     procedure UndoClick(Sender: TObject);
  106.     procedure FormCreate(Sender: TObject);
  107.     procedure FormActivate(Sender: TObject);
  108.   private
  109.     { Private declarations }
  110.   public
  111.     { Public declarations }
  112.   end;
  113.  
  114. var
  115.   Form1: TForm1;
  116.  
  117. {Two functions used to apply a Matrix Filter of the given Size - See Below}
  118. procedure Apply33(Picbuf:TPicbuf);
  119. procedure Apply55(Picbuf:TPicbuf);
  120. {Valid File Format}
  121. function  ValidFormat(FileName:String):Boolean;                       {See Below}                                          {5*5}
  122.  
  123. implementation
  124.  
  125. {$R *.DFM}
  126.  
  127. {-------------------------------------------------------------------------------}
  128. {Load Image into the 'PicbufOriginal' picbuf. After this occurs, the Image is
  129. copied to the 'Edit' and 'Visible' Picbuf Controls - See Below}
  130. procedure TForm1.LoadImageClick(Sender: TObject);
  131. begin
  132. {Open Dialog}
  133. if OpenDialog.Execute then
  134. begin
  135. Application.ProcessMessages;
  136. {Set Name}
  137. PicbufOriginal.Filename:=OpenDialog.Filename;
  138. {Load Image}
  139. PicbufOriginal.Load;
  140. end;
  141. end;
  142.  
  143. {--------------------------------------------------------------------------------}
  144. {Save Visible Image to Disk based on extension}
  145. procedure TForm1.SaveImageAs1Click(Sender: TObject);
  146. begin
  147. if OpenDialog.Execute then
  148. begin
  149. Application.ProcessMessages;
  150. {Set FileName}
  151. PicbufVisible.FileName := OpenDialog.Filename;
  152. {Check to see a Valid filename exists - See function Below}
  153. if ValidFormat(PicbufVisible.FileName) then      {Pass the fileName to the function}
  154. PicbufVisible.Store                                                  {Save if Valid}
  155. else
  156. MessageDlg('Your File Extension is Not Valid.', mtInformation, [mbOk], 0);
  157. end;
  158. end;
  159.  
  160. {-------------------------------------------------------------------------------}
  161. {Use change event of the 'OriginalImage', to copy the Image to the 'PicbufEdit'
  162. control.  This means we can then work on a 'Copy' of the Image.}
  163. procedure TForm1.PicbufOriginalChange(Sender: TObject);
  164. var
  165. HDIB:Integer;
  166. begin
  167. {Copy from the 'PicbufOriginal' Image to the 'PicbufEdit'}
  168. hDIB := PicbufOriginal.DuplicateDib(0);
  169. {Import into 'EditPicbuf' ready for applying an effect}
  170. PicbufEdit.ImportDib(hDIB, False);
  171. end;
  172.  
  173. {-------------------------------------------------------------------------------}
  174. {Whenever we apply an effect to the 'PicbufEdit' it causes a change event to occur-
  175. use this event to copy the 'adjusted Image' to the 'PicbufVisible' Image - the
  176. one we see on Screen}
  177. procedure TForm1.PicbufEditChange(Sender: TObject);
  178. var
  179. Hdib:Integer;
  180. begin
  181. {Copy from 'Edit Picbuf' to 'Visible Picbuf'}
  182. hDIB := PicbufEdit.DuplicateDib(0);
  183. PicbufVisible.ImportDib(hDIB, False);
  184. end;
  185.  
  186. {-------------------------------------------------------------------------------}
  187. {Enable/Disable Buttons/Scrollbars depending on required function. Depending
  188. which option the user selects, the effect selected is applied either with the
  189. 'ScrollBar' or with the 'Process' Button. Use the ItemIndex value to determine
  190. which button is selected, and enable/disable the ScrollBar/Button as required}
  191. procedure TForm1.RadioGroupClick(Sender: TObject);
  192. begin
  193. case RadioGroup.ItemIndex of
  194. 0:{Soften}
  195.   begin
  196.   ScrollBar.Enabled:=True; {Enable Scroll Bar}
  197.   Process.Enabled:=False;  {Disable Process Button}
  198.   end;
  199. 1:{Sharpen}
  200.   begin
  201.   ScrollBar.Enabled:=True;
  202.   Process.Enabled:=False;
  203.   end;
  204. 2:{Blur}
  205.   begin
  206.   ScrollBar.Enabled:=False;
  207.   Process.Enabled:=True;
  208.   end;
  209. 3:{Edge}
  210.   begin
  211.   ScrollBar.Enabled:=True;
  212.   Process.Enabled:=False;
  213.   end;
  214. 4:{Matrix}
  215.   begin
  216.   ScrollBar.Enabled:=False;
  217.   Process.Enabled:=True;
  218.   end;
  219. end;
  220. end;
  221.  
  222.  
  223. {-------------------------------------------------------------------------------}
  224. {Apply a 'function' using the 'ScrollBar' and  based on which function is selected
  225. by the user.  The 'Scrollbar' is used only to apply Soften, Sharpen or Edge. So
  226. we only refer to those buttons in the sub below - Again Note that the ItemIndex
  227. property of the RadioGroup indicates which button is selected}
  228. procedure TForm1.ScrollBarChange(Sender: TObject);
  229. begin
  230. {Apply the effect - the amount of effect is the Position of the ScrollBar [1-10]}
  231. case RadioGroup.ItemIndex of {Reference RadioButton Group}
  232. 0:PicbufEdit.Soften(ScrollBar.Position);                                 {Soften}
  233. 1:PicbufEdit.Sharpen(ScrollBar.Position);                               {Sharpen}
  234. 3:PicbufEdit.ExtractEdges(ScrollBar.Position);                             {Edge}
  235. end;
  236. end;
  237.  
  238.  
  239. {-------------------------------------------------------------------------------}
  240. {Similar to the OnClick event of the ScrollBar. This time the user can apply either
  241. 'Blur' or the 'Matrix Filter' to the Image using the Process Button. Again we can
  242. determine which one to apply by using the ItemIndex of the RadioGroup - this tells
  243. us which button is selected}
  244. procedure TForm1.ProcessClick(Sender: TObject);
  245. begin
  246. Case RadioGroup.ItemIndex of
  247.  2:PicbufEdit.Blur;                                                  {Blur Image}
  248.  4:                                                               {Matrix Filter}
  249. begin
  250. {When we apply the Matrix filter, we must apply the correct filter size. In
  251. order to apply the desired filter size, we apply which ever 'Matrix' filter is
  252. visible to the user, this can be either 3 * 3 or 5 * 5.  The Matrix elements are
  253. contained within a 'TabbedNotebook' TObject.  The 3 * 3 filter is placed on the
  254. first 'Page' and the 5 * 5 filter is placed on the second 'page'. So we can then
  255. refer to the PageIndex property of the Notebook to determine which Matrix is
  256. visible and hence which to apply. 'PageIndex' will be 0 for 3 * 3 and 1 for 5* 5}
  257. case MatrixPage.PageIndex of                                  {Refer to NoteBook}
  258.  0: Apply33(PicbufEdit);        {Apply 3*3 Filter to Image - See procedure Below}
  259.  1: Apply55(PicbufEdit);        {Apply 5*5 Filter to Image - See procedure Below}
  260. end;
  261. end;
  262. end;
  263. end;
  264.  
  265.  
  266. {-------------------------------------------------------------------------------}
  267. {Apply a 3 * 3 Matrix to the passed 'Picture Buffer'. This procedure applies
  268. a 3 * 3 Matrix Filter to the 'passed' picbuf - called 'PICBUF'. When you call
  269. this procedure, simply pass the name of the Picbuf you wish the matrix effect to
  270. be applied to :- Apply33(MYPICBUF);}
  271.  
  272. procedure Apply33(Picbuf:TPicbuf);
  273.  
  274. Type {Used to get a pointer to a 3*3 array}
  275. Matrix33 = ^Matrix33array;
  276. Matrix33array = array[0..2,0..2] of Integer;
  277.  
  278. Var {Used to Hold and Get and Apply User Data - Global this Unit}
  279. Matrix33data : Matrix33array;{Array}
  280.  
  281. begin
  282. {Fill in the array elements with the edit box values}
  283. with Form1 do
  284. begin
  285. Matrix33data[0,0] := Element00.Value; {Upper Left}
  286. Matrix33data[0,1] := Element01.Value;
  287. Matrix33data[0,2] := Element02.Value;
  288. Matrix33data[1,0] := Element10.Value; {Middle Row Left}
  289. Matrix33data[1,1] := Element11.Value; {Center Point}
  290. Matrix33data[1,2] := Element12.Value; {Middle Row Right}
  291. Matrix33data[2,0] := Element20.Value;
  292. Matrix33data[2,1] := Element21.Value;
  293. Matrix33data[2,2] := Element22.Value; {Lower Right}
  294. {Apply the Filter to the passed Picbuf}
  295. Picbuf.MatrixFilter(3,@Matrix33data,Scale.Value,Norm.Value,Offset.Value);
  296. end;
  297. end;
  298.  
  299.  
  300. {-------------------------------------------------------------------------------}
  301. {Apply a 5 * 5 Matrix to the passed 'Picture Buffer'. This procedure applies
  302. a 5 * 5 Matrix Filter to the 'passed' picbuf - called 'PICBUF'. When you call
  303. this procedure, simply pass the name of the Picbuf you wish the matrix effect to
  304. be applied to :- Apply55(MYNEWPICBUF);}
  305.  
  306. procedure Apply55(Picbuf:TPicbuf);
  307.  
  308. Type {Used to get a pointer to a 5*5 array}
  309. Matrix55 = ^Matrix55array;
  310. Matrix55array = array[0..4,0..4] of Integer;
  311.  
  312. Var {Used to Hold and Get and Apply User Data - Global this Unit}
  313. Matrix55data : Matrix55array;{Array}
  314.  
  315. begin
  316. {Fill in the array elements with the edit box values}
  317. with Form1 do{Reference form that holds the Edit Boxes}
  318. begin
  319. {Top Row Starting Left Side}
  320. Matrix55data[0,0] := Element500.Value;
  321. Matrix55data[0,1] := Element501.Value;
  322. Matrix55data[0,2] := Element502.Value;
  323. Matrix55data[0,3] := Element503.Value;
  324. Matrix55data[0,4] := Element504.Value;
  325. {Next Row}
  326. Matrix55data[1,0] := Element510.Value;
  327. Matrix55data[1,1] := Element511.Value;
  328. Matrix55data[1,2] := Element512.Value;
  329. Matrix55data[1,3] := Element513.Value;
  330. Matrix55data[1,4] := Element514.Value;
  331. {Next Row}
  332. Matrix55data[2,0] := Element520.Value;
  333. Matrix55data[2,1] := Element521.Value;
  334. Matrix55data[2,2] := Element522.Value;
  335. Matrix55data[2,3] := Element523.Value;
  336. Matrix55data[2,4] := Element524.Value;
  337. {Next Row}
  338. Matrix55data[3,0] := Element530.Value;
  339. Matrix55data[3,1] := Element531.Value;
  340. Matrix55data[3,2] := Element532.Value;
  341. Matrix55data[3,3] := Element533.Value;
  342. Matrix55data[3,4] := Element534.Value;
  343. {Bottom Row}
  344. Matrix55data[4,0] := Element540.Value;
  345. Matrix55data[4,1] := Element541.Value;
  346. Matrix55data[4,2] := Element542.Value;
  347. Matrix55data[4,3] := Element543.Value;
  348. Matrix55data[4,4] := Element544.Value;
  349. {Apply Filter}
  350. Picbuf.MatrixFilter(5,@Matrix55data,Scale5.Value,Norm5.Value,Offset5.Value);
  351. end;
  352. end;
  353.  
  354. {-------------------------------------------------------------------------------}
  355. {Undo}
  356. procedure TForm1.UndoClick(Sender: TObject);
  357. begin
  358. {Force a call to the 'OriginalPicbuf' Change event - this will reload the original
  359. Image};
  360. PicbufOriginalChange(Sender);
  361. end;
  362.  
  363. {-------------------------------------------------------------------------------}
  364. {Exit Application}
  365. procedure TForm1.Exit1Click(Sender: TObject);
  366. begin
  367. Halt;
  368. end;
  369.  
  370.  
  371. {-------------------------------------------------------------------------------}
  372. { This function simply checks to see if any one of the listed ImageKnife formats
  373. exist in the filename passed to the function. If it does then the function
  374. evaluates to true - Note this is the RESULT of the function.}
  375. function ValidFormat(FileName:String):Boolean;
  376. Var
  377. Temp:String;
  378. begin
  379. Temp := UpperCase(Filename);{Convert FileName to Upper Case}
  380. Result:=False;{Default result if no recognised match is found - *.*}
  381. if Pos('.TIF', Temp ) > 0 then Result:= True;           {for Pos see Delphi Help}
  382. if Pos('.TGA', Temp ) > 0 then Result:= True;
  383. if Pos('.BMP', Temp ) > 0 then Result:= True;
  384. if Pos('.GIF', Temp ) > 0 then Result:= True;
  385. if Pos('.DIB', Temp ) > 0 then Result:= True;
  386. if Pos('.PCX', Temp ) > 0 then Result:= True;
  387. if Pos('.JPG', Temp ) > 0 then Result:= True;
  388. if Pos('.MSP', Temp ) > 0 then Result:= True;
  389. if Pos('.FIF', Temp ) > 0 then Result:= True;
  390. if Pos('.PNG', Temp ) > 0 then Result:= True;
  391. end;
  392.  
  393. {--------------------------------------------------------------------------------}
  394. {Set Up any Defaults}
  395. procedure TForm1.FormCreate(Sender: TObject);
  396. begin
  397. Application.HintPause:=10;
  398. Application.HintColor:=clAqua;
  399. end;
  400.  
  401. procedure TForm1.FormActivate(Sender: TObject);
  402. begin
  403. PicbufOriginal.Filename:='..\images\marybeth.tif';
  404. PicbufOriginal.Load;
  405. PicBufVisible.ScrollBars := SB_Both;
  406. end;
  407.  
  408. end.
  409.