home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / delphi2.shr / USTORE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-08-01  |  9.1 KB  |  271 lines
  1. {  Project Store.DPR Delphi 2.0 Demos
  2.  
  3.   Description:- Store.Dpr Project:-
  4.  
  5.    Demonstrates the use of:
  6.  
  7.    1) 'FileName'
  8.    2) 'ImageFormat'
  9.    3) 'ImageCompression'
  10.    4) 'Write Options'
  11.    5) JPG
  12.  
  13.  
  14.    Date of Origin: 18/04/96
  15.    Original Author: Andrew Hutchison
  16.    Modification History:
  17.  
  18.    Date        Person                            Change
  19.    ----------------------------------------------------
  20.    18/04/96    A Hutchison                       Created
  21.  
  22.    (c) Copyright Media Architects Inc. 1996.
  23.    All rights reserved.   No part of this program may be
  24.    photocopied, reproduced, translated to another programming
  25.    language or transported to any computer system without the
  26.    prior written consent of Media Architects Inc.}
  27.  
  28. unit UStore;
  29.  
  30. interface
  31.  
  32. uses
  33.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  34.   OleCtrls, ImageKnife32, ExtCtrls, Menus, StdCtrls, Spin;
  35.  
  36. type
  37.   TForm1 = class(TForm)
  38.     OpenDialog: TOpenDialog;
  39.     MainMenu1: TMainMenu;
  40.     File1: TMenuItem;
  41.     LoadImage1: TMenuItem;
  42.     SaveImageAs1: TMenuItem;
  43.     N1: TMenuItem;
  44.     Exit1: TMenuItem;
  45.     Bevel1: TBevel;
  46.     Picbuf1: TPicbuf;
  47.     Jpgoptions: TRadioGroup;
  48.     FileType: TComboBox;
  49.     ImageCompressionLevel: TSpinEdit;
  50.     procedure FormCreate(Sender: TObject);
  51.     procedure SaveImageAs1Click(Sender: TObject);
  52.     procedure FileTypeChange(Sender: TObject);
  53.     procedure LoadImage1Click(Sender: TObject);
  54.     procedure Exit1Click(Sender: TObject);
  55.   private
  56.     { Private declarations }
  57.   public
  58.     { Public declarations }
  59.   end;
  60.  
  61. var
  62. Form1: TForm1;
  63.  
  64. {See Below}
  65. procedure SetSaveModes(SetPicbuf:TPicbuf);
  66. {See Below}
  67. function GetImageFormat(FileName:String):Integer;
  68. {This Returns 'True' if the supplied filename is valid}
  69. function ValidImageFormat(FileName:String):Boolean;
  70. {This Returns FileImage format as text ie '*.BMP'}
  71. function ImageFormatasString(FileFormat:Integer):String;
  72.  
  73. implementation
  74.  
  75. {$R *.DFM}
  76.  
  77.  
  78. {-------------------------------------------------------------------------------}
  79. {Defaults on 'Form' creation}
  80. procedure TForm1.FormCreate(Sender: TObject);
  81. begin
  82. Application.HintPause:=10;
  83. Application.HintColor:=clAqua;
  84.  
  85. {Make Sure ComboBox and OpenDialog Filters are in Sync and set to *.*}
  86. FileType.ItemIndex:=0;
  87. OpenDialog.FilterIndex:=0;
  88. end;
  89.  
  90.  
  91. {-------------------------------------------------------------------------------}
  92. {Load an Image into the Picbuf}
  93. procedure TForm1.LoadImage1Click(Sender: TObject);
  94. begin
  95.  
  96. {Display Common Dialog Control}
  97. if OpenDialog.Execute then
  98. begin
  99.  
  100. {Set Name}
  101. Picbuf1.Filename:=OpenDialog.FileName;
  102.  
  103. {Load Image}
  104. Picbuf1.Load;
  105. end;
  106. end;
  107.  
  108.  
  109. {-------------------------------------------------------------------------------}
  110. {Whenever the user selects a Filetype [with the ComboBox], update the Common
  111. Dialog Controls Filter Index to reflect the Change - Keep them in Sync.}
  112. procedure TForm1.FileTypeChange(Sender: TObject);
  113. begin
  114. OpenDialog.FilterIndex := FileType.ItemIndex + 1;
  115. end;
  116.  
  117.  
  118. {-------------------------------------------------------------------------------}
  119. {Save the Visible Image.
  120.  
  121. Uses three function Calls.  'GetImageformat' is used to determine the ImageFormat
  122. number of the file to be Saved. This is required in case the user types in the
  123. file path and name, rather than using the pre-picked format [combobox setting].
  124.  
  125. Prior to saving the Image, the 'SetSaveModes' function is called. Pass the Picbuf
  126. to be saved to this function. Within that function, if the user is going to be
  127. saving a 'JPG' file, the various Write Options are Set - See Below.
  128.  
  129. Finally prior to Displaying the OpenDialog Control, the Filename is set to the
  130. extension of the format the user has selected.  If you do not do this, then the
  131. Dialog remembers the Name and Path of the last file to be loaded. This can create
  132. a problem, since we may wish to save the file in a new format - not required but
  133. catches a potential error. 'ImageFormatasString' returns the file extension based
  134. on the supplied format number. By doing this, it also forces the Dialog to list
  135. all the files of the selected file type.}
  136. procedure TForm1.SaveImageAs1Click(Sender: TObject);
  137. begin
  138. {Set Open Dialog to FileType ComboBox Selection}
  139. OpenDialog.FilterIndex := FileType.ItemIndex + 1;
  140.  
  141. {We Set the 'Filename' Property to the Extension Selected by the User - this stops
  142. the problem of the Dialog Box remembering the last Filename and format - since
  143. we may wish to alter the format it is Saved As.}
  144. OpenDialog.FileName := ImageFormatasString(FileType.ItemIndex);       {See Below}
  145.  
  146. {Display Dialog}
  147. if OpenDialog.Execute then
  148. begin
  149.  
  150. {Update the ComboBox to FileName's Format - Overrides selected type if the user typed
  151. in a new name and extension}
  152. FileType.ItemIndex := GetImageFormat(OpenDialog.FileName);
  153.  
  154. {Call Procedure to Set Write Options - Sets JPG Options}
  155. SetSaveModes(Picbuf1);
  156.  
  157. {Set Filename}
  158. Picbuf1.FileName := OpenDialog.FileName;
  159.  
  160. {Store Image if it has a valid extension - See Function Below}
  161. if ValidImageFormat(Picbuf1.FileName) then
  162. Picbuf1.Store
  163. else
  164. MessageDlg('File Name or Extension is not Valid', mtConfirmation, [mbOK], 0);
  165. end;
  166. end;
  167.  
  168.  
  169. {-------------------------------------------------------------------------------}
  170. {This Procedure is used to set a 'Picbufs' Save Options. To use it simply call the
  171. function, passing the name of the Picbuf you wish to set -
  172.  
  173. - SetSaveModes(MyPicbuf);
  174.  
  175. Notice the use of 'With SETPICBUF do'.  From that point on you need make no
  176. further reference to the Picbuf.  You need just reference the properties you
  177. wish to set.}
  178. procedure SetSaveModes(SetPicbuf:TPicbuf);{Refer to this name within the procedure}
  179. begin
  180.  
  181. with SetPicbuf do   {Reference Picbuf - this is the Picbuf sent to the Procedure}
  182. begin
  183. ImageFormat:= Form1.FileType.ItemIndex;     {SetImage Format - Based on ComboBox}
  184. ImageCompression := 0;                     {Default to NO compression as default}
  185.  
  186. if Imageformat = 7 then           {JPG - Set Write Option Based on Radio Buttons}
  187. begin
  188. WriteOption := Form1.Jpgoptions.ItemIndex;   {Set Write Option Based on Option's}
  189. ImageCompression := Form1.ImageCompressionlevel.Value {Set JPG Compression level}
  190.  
  191. end;
  192. end;
  193. end;
  194.  
  195. {-------------------------------------------------------------------------------}
  196. {This Function returns the 'Integer format' number of a given file name. Pass any
  197. file path and name to the function and it will return the ImageFormat Number.
  198. Note the use of 'Result'.  Any function you create by default has an in-built
  199. 'Result' variable.  So when you call a function your result is automatically
  200. available for use.
  201.  
  202. For example:-
  203.  
  204. ImageType.ItemIndex := GetImageFormat(OpenDialog.Filename);
  205.  
  206. This sets the ItemIndex to the value as returned by the function.  Note how we
  207. pass the function a string - eg a 'FileName' returned by a Common Dialog Control}
  208. function GetImageFormat(FileName:String):Integer;
  209. Var
  210. Temp:String;
  211. begin
  212. Temp := UpperCase(Filename);{Convert FileName to Upper Case}
  213. Result:=0;{Default result if no recognised match is found - *.*}
  214. if Pos('.TIF', Temp ) > 0 then Result:= 1;
  215. if Pos('.TGA', Temp ) > 0 then Result:= 2;
  216. if Pos('.BMP', Temp ) > 0 then Result:= 3;
  217. if Pos('.GIF', Temp ) > 0 then Result:= 4;
  218. if Pos('.DIB', Temp ) > 0 then Result:= 5;
  219. if Pos('.PCX', Temp ) > 0 then Result:= 6;
  220. if Pos('.JPG', Temp ) > 0 then Result:= 7;
  221. if Pos('.MSP', Temp ) > 0 then Result:= 8;
  222. if Pos('.FIF', Temp ) > 0 then Result:= 9;
  223. if Pos('.PNG', Temp ) > 0 then Result:= 10;
  224. {Refer to Delphi On-line Help for 'POS' function}
  225. end;
  226.  
  227. {-------------------------------------------------------------------------------}
  228. {This evaluates to true if the supplied filename is Valid}
  229. function ValidImageFormat(FileName:String):Boolean;
  230. Var
  231. Temp:String;
  232. begin
  233. Temp := UpperCase(Filename);{Convert FileName to Upper Case}
  234. Result:= False;{Default result if no recognised match is found - False}
  235. if Pos('.TIF', Temp ) > 0 then Result:= True;
  236. if Pos('.TGA', Temp ) > 0 then Result:= True;
  237. if Pos('.BMP', Temp ) > 0 then Result:= True;
  238. if Pos('.GIF', Temp ) > 0 then Result:= True;
  239. if Pos('.DIB', Temp ) > 0 then Result:= True;
  240. if Pos('.PCX', Temp ) > 0 then Result:= True;
  241. if Pos('.JPG', Temp ) > 0 then Result:= True;
  242. if Pos('.MSP', Temp ) > 0 then Result:= True;
  243. if Pos('.FIF', Temp ) > 0 then Result:= True;
  244. if Pos('.PNG', Temp ) > 0 then Result:= True;
  245. end;
  246.  
  247. {This Returns FileImage format as Text ie '*.BMP' from the supplied Integer format}
  248. function ImageFormatasString(FileFormat:Integer):String;
  249. begin
  250. Result:= '*.*';{Default result  - False}
  251. if FileFormat =  1  then Result:= '.TIF';
  252. if FileFormat =  2  then Result:= '.TGA';
  253. if FileFormat =  3  then Result:= '.BMP';
  254. if FileFormat =  4  then Result:= '.GIF';
  255. if FileFormat =  5  then Result:= '.DIB';
  256. if FileFormat =  6  then Result:= '.PCX';
  257. if FileFormat =  7  then Result:= '.JPG';
  258. if FileFormat =  8  then Result:= '.MSP'; {PaintBrush}
  259. if FileFormat =  9  then Result:= '.FIF';
  260. if FileFormat =  10  then Result:= '.PNG';
  261. end;
  262.  
  263. {--------------------------------------------------------------------------------}
  264. {Exit}
  265. procedure TForm1.Exit1Click(Sender: TObject);
  266. begin
  267. Halt;
  268. end;
  269.  
  270. end.
  271.