home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / delphi2.shr / UGREYNEG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-01  |  7.3 KB  |  208 lines
  1. {  Project GreyNeg.DPR Delphi 2.0 Demos
  2.  
  3.    Description:- GreyNeg.Dpr Project:-
  4.  
  5.    Demonstrates the use of:
  6.  
  7.    1) 'GrayScale'
  8.    2) 'Mirror'
  9.    3) 'Rotate'
  10.    4) 'Negate'
  11.    5) 'ImportDib & DuplicateDib'
  12.  
  13.    Date of Origin: 15/04/96
  14.    Original Author: Andrew Hutchison
  15.    Modification History:
  16.  
  17.    Date        Person                            Change
  18.    ----------------------------------------------------
  19.    15/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 UGreyNeg;
  28.  
  29. interface
  30.  
  31. uses
  32.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  33.   Menus, Buttons, ExtCtrls, StdCtrls, OleCtrls, ImageKnife32, Spin;
  34.  
  35. type
  36.   TForm1 = class(TForm)
  37.     PicbufVisible: TPicbuf;
  38.     PicbufOriginal: TPicbuf;
  39.     RadioGroup: TRadioGroup;
  40.     Bevel1: TBevel;
  41.     ProcessImage: TSpeedButton;
  42.     Undo: TSpeedButton;
  43.     MainMenu1: TMainMenu;
  44.     File1: TMenuItem;
  45.     LoadImage: TMenuItem;
  46.     SaveImageAs: TMenuItem;
  47.     N1: TMenuItem;
  48.     Exit: TMenuItem;
  49.     Angle: TSpinEdit;
  50.     OpenDialog: TOpenDialog;
  51.     procedure LoadImageClick(Sender: TObject);
  52.     procedure PicbufOriginalChange(Sender: TObject);
  53.     procedure ProcessImageClick(Sender: TObject);
  54.     procedure UndoClick(Sender: TObject);
  55.     procedure ExitClick(Sender: TObject);
  56.     procedure SaveImageAsClick(Sender: TObject);
  57.     procedure FormCreate(Sender: TObject);
  58.     procedure RadioGroupClick(Sender: TObject);
  59.     procedure FormActivate(Sender: TObject);
  60.   private
  61.     { Private declarations }
  62.   public
  63.     { Public declarations }
  64.   end;
  65.  
  66. var
  67.   Form1: TForm1;
  68.  
  69. function ValidFormat(FileName:String):Boolean;{See Below}
  70.  
  71. implementation
  72.  
  73. {$R *.DFM}
  74.  
  75. {-------------------------------------------------------------------------------}
  76. {Load Image into background Picbuf control called 'PicbufOriginal'.  When this
  77. occurs a 'Changeevent' is triggered in that buffer. Use that event to copy the
  78. Image to the 'PicbufVisible' Control.  This means we are working with a Copy of
  79. the Image - See Below for Change Event}
  80. procedure TForm1.LoadImageClick(Sender: TObject);
  81. begin
  82. {Use CommonDialog Box to get FileName}
  83. if OpenDialog.Execute then
  84.   begin
  85.   {Set FileName}
  86.   PicbufOriginal.FileName:=OpenDialog.FileName;
  87.   {Call Load Method}
  88.   PicbufOriginal.Load;
  89.   end;
  90. end;
  91.  
  92.  
  93. {-------------------------------------------------------------------------------}
  94. {Copy original Image to visible Image using DIB's. The Image is copied to the
  95. 'PicbufVisible' when you load an Image or Change the Image within the Original
  96. Picbuf - Change Event}
  97. procedure TForm1.PicbufOriginalChange(Sender: TObject);
  98. var
  99. Hdib:Integer;{Store the Dib}
  100. begin
  101. hDIB := PicbufOriginal.DuplicateDib(0);        {Copy the Original Image - Pass O}
  102. PicbufVisible.ImportDib(hDIB, False);         {Display Copied Image - Pass False}
  103. end;
  104.  
  105.  
  106. {-------------------------------------------------------------------------------}
  107. {Save 'PicbufVisible' Picbuf Image - Reuse CommonDialog Control}
  108. procedure TForm1.SaveImageAsClick(Sender: TObject);
  109. begin
  110. if OpenDialog.Execute then
  111.  begin
  112.  PicbufVisible.Filename:=OpenDialog.filename;                      {Set FileName}
  113.   if ValidFormat(PicbufVisible.Filename)then{See Below - Is File extension Valid}
  114.   PicbufVisible.Store                                {Call Save Method of Picbuf}
  115.   else
  116.   MessageDlg('Your File Extension is Not Valid.', mtInformation, [mbOk], 0);
  117.  end;
  118. end;
  119.  
  120. {-------------------------------------------------------------------------------}
  121. {Undo any changes.  We Simply recall the 'ChangeEvent' of the 'PicbufOriginal'
  122. Picbuf. This causes the original Image to be copied to the 'PicbufVisible' picbuf
  123. control}
  124. procedure TForm1.UndoClick(Sender: TObject);
  125. begin
  126. PicbufOriginalChange(Sender);                                      {Recall event}
  127. end;
  128.  
  129. {-------------------------------------------------------------------------------}
  130. {Apply desired function to visible Image.  When the user clicks the Process Button
  131. a click event is triggered. We can reference each button within the 'RadioButton'
  132. Group using their ItemIndex - top Button is GrayScale Index No 0, Next Button is
  133. Index 1 and so on. Simply use a 'SelectCase' based on their ItemIndex values - the
  134. ItemIndex reflects which button is checked.}
  135. procedure TForm1.ProcessImageClick(Sender: TObject);
  136. begin
  137. case RadioGroup.ItemIndex of                               {Radio Button Control}
  138. 0:PicbufVisible.GrayScale;                                          {Gray Button}
  139. 1:PicbufVisible.Negate;                                                  {Negate}
  140. 2:PicbufVisible.Mirror(-1, 0);{Must Pass -1 for True and 0 for False      Mirror}
  141. 3:PicbufVisible.Mirror(0, -1);{Must Pass -1 for True and 0 for False      Mirror}                                          {Mirror}
  142. 4:{Rotate Image Based on Edit Box Value}
  143. begin
  144. PicbufVisible.Rotate(Angle.Value,RGB(255,0,0))                     {Rotate Image}
  145. end;
  146. end;
  147. end;
  148.  
  149. {-------------------------------------------------------------------------------}
  150. {Show / Hide Rotate Option Edit Box - Use ItemIndex. If the ItemIndex is not 4
  151. then the user is not wanting rotation so hide the Input box. 'Click Event' from
  152. RadioGroup.}
  153. procedure TForm1.RadioGroupClick(Sender: TObject);
  154. begin
  155. if RadioGroup.ItemIndex = 4 then
  156. Angle.Visible:= True                                                       {Hide}
  157. else                                                                       {Show}
  158. Angle.Visible:=False;
  159. end;
  160.  
  161.  
  162. {-------------------------------------------------------------------------------}
  163. {Close All Forms}
  164. procedure TForm1.ExitClick(Sender: TObject);
  165. begin
  166. Halt;
  167. end;
  168.  
  169.  
  170. {-------------------------------------------------------------------------------}
  171. {Any Defaults on Creation - Not Part of MAI Demo}
  172. procedure TForm1.FormCreate(Sender: TObject);
  173. begin
  174. Application.HintPause:=10;
  175. Application.HintColor:=clAqua;
  176. end;
  177.  
  178. {-------------------------------------------------------------------------------}
  179. { This function simply checks to see if any one of the listed ImageKnife formats
  180. exist in the filename passed to the function. If it does then the function
  181. evaluates to true - Note this is the RESULT of the function}
  182. function ValidFormat(FileName:String):Boolean;
  183. Var
  184. Temp:String;
  185. begin
  186. Temp := UpperCase(Filename);{Convert FileName to Upper Case}
  187. Result:=False;{Default result if no recognised match is found - *.*}
  188. if Pos('.TIF', Temp ) > 0 then Result:= True;
  189. if Pos('.TGA', Temp ) > 0 then Result:= True;
  190. if Pos('.BMP', Temp ) > 0 then Result:= True;
  191. if Pos('.GIF', Temp ) > 0 then Result:= True;
  192. if Pos('.DIB', Temp ) > 0 then Result:= True;
  193. if Pos('.PCX', Temp ) > 0 then Result:= True;
  194. if Pos('.JPG', Temp ) > 0 then Result:= True;
  195. if Pos('.MSP', Temp ) > 0 then Result:= True;
  196. if Pos('.FIF', Temp ) > 0 then Result:= True;
  197. if Pos('.PNG', Temp ) > 0 then Result:= True;
  198. end;
  199.  
  200. procedure TForm1.FormActivate(Sender: TObject);
  201. begin
  202.   PicBufVisible.ScrollBars := SB_Both;
  203.   PicBufOriginal.Filename := '..\images\twirl1.jpg';
  204.   PicBufOriginal.Load;
  205. end;
  206.  
  207. end.
  208.