home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / delphi2.shr / ULOAD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-01  |  12.1 KB  |  328 lines
  1. {  Project Load.DPR Delphi 2.0 Demos
  2.  
  3.    Description:- Load.Dpr Project:-
  4.  
  5.    Demonstrates the use of:
  6.  
  7.    1) 'FileName'
  8.    2) 'ImageNumber'
  9.    3) 'Imageformat'
  10.    4) 'Callbacks'
  11.    5) 'Load'
  12.    6) 'Load Callbacks'
  13.    7) Progress Bars
  14.  
  15.    Date of Origin: 16/04/96
  16.    Original Author: Andrew Hutchison
  17.    Modification History:
  18.  
  19.    Date        Person                            Change
  20.    ----------------------------------------------------
  21.    16/04/96    A Hutchison                       Created
  22.  
  23.    (c) Copyright Media Architects Inc. 1996.
  24.    All rights reserved.   No part of this program may be
  25.    photocopied, reproduced, translated to another programming
  26.    language or transported to any computer system without the
  27.    prior written consent of Media Architects Inc.}
  28.  
  29. unit ULoad;
  30.  
  31. interface
  32.  
  33. uses
  34.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  35.   Menus, OleCtrls, ImageKnife32, ExtCtrls, Buttons, StdCtrls, Spin,
  36.   ComCtrls;
  37.  
  38. type
  39.   TForm1 = class(TForm)
  40.     MainMenu1: TMainMenu;
  41.     File1: TMenuItem;
  42.     LoadImage1: TMenuItem;
  43.     LoadImagewithCallBacks1: TMenuItem;
  44.     N1: TMenuItem;
  45.     Exit1: TMenuItem;
  46.     Bevel1: TBevel;
  47.     Picbuf1: TPicbuf;
  48.     ImageType: TComboBox;
  49.     GroupBox1: TGroupBox;
  50.     ImageNumber: TSpinEdit;
  51.     GroupBox2: TGroupBox;
  52.     LoadOption: TComboBox;
  53.     LoadScale: TComboBox;
  54.     LoadWidth: TSpinEdit;
  55.     LoadButton: TSpeedButton;
  56.     LoadCallbackButton: TSpeedButton;
  57.     Label1: TLabel;
  58.     Label2: TLabel;
  59.     Label3: TLabel;
  60.     OpenDialog: TOpenDialog;
  61.     LineNumber: TLabel;
  62.     Label5: TLabel;
  63.     ProgressBar: TProgressBar;
  64.     Bevel2: TBevel;
  65.     BarMax: TSpinEdit;
  66.     Picbuf2: TPicbuf;
  67.     procedure FormCreate(Sender: TObject);
  68.     procedure ImageTypeClick(Sender: TObject);
  69.     procedure LoadImage1Click(Sender: TObject);
  70.     procedure LoadImagewithCallBacks1Click(Sender: TObject);
  71.     procedure LoadButtonClick(Sender: TObject);
  72.     procedure LoadCallbackButtonClick(Sender: TObject);
  73.     procedure Picbuf1Callback(Sender: TObject; var Lines: Smallint);
  74.     procedure BarMaxChange(Sender: TObject);
  75.     procedure Exit1Click(Sender: TObject);
  76.     procedure FormActivate(Sender: TObject);
  77.   private
  78.     { Private declarations }
  79.   public
  80.     { Public declarations }
  81.   end;
  82.  
  83. var
  84.   Form1: TForm1;
  85.  
  86. {Function's and Procedures used below - By placing them here you can re-use them
  87. from any unit with this units name in its USES clause}
  88.  
  89. {Set a Picbuf's Load Options - Pass the Name of the Picbuf to Set}
  90. procedure SetLoadModes(SetPicbuf:TPicbuf);
  91. {Determine the Image Format Number from the given String - Returns Integer 0-10}
  92. function GetImageFormat(FileName:String):Integer;
  93. {Determine if the passed index value is a Valid file extension for CallBacks -
  94. returns a True or False}
  95. function ValidCallBack(ImageFormatIndex:Integer):Boolean;
  96. {See Below for Functions}
  97.  
  98. implementation
  99.  
  100. {$R *.DFM}
  101.  
  102. {-------------------------------------------------------------------------------}
  103. {Set up defaults.  Including setting the Combo Boxes to there default locations}
  104. procedure TForm1.FormCreate(Sender: TObject);
  105. begin
  106. Application.HintPause := 10;
  107. Application.HintColor := clAqua;
  108. ImageType.ItemIndex :=0;                                  {'ImageType' Combo Box}
  109. LoadOption.ItemIndex:=0;                                {'LoadOptions' Combo Box}
  110. LoadScale.ItemIndex:=0;                                   {'LoadScale' Combo Box}
  111. ProgressBar.Max := BarMax.Value;                     {Set Progress to user Value}
  112. end;
  113.  
  114.  
  115. {-------------------------------------------------------------------------------}
  116. {Load an Image from disk using a Common Dialog control - No Call Backs}
  117. procedure TForm1.LoadImage1Click(Sender: TObject);
  118. begin
  119. {Display Dialog}
  120. if OpenDialog.Execute then
  121. begin
  122. {Catch Up}
  123. Application.ProcessMessages;
  124.  
  125. {Set 'ImageType' & 'Combobox' to reflect the extension of the selected file - this
  126. uses the procedure called 'GetImageFormat' - See Below. This is, in case the user
  127. typed in a file extension when the dialog is being displayed.}
  128. ImageType.ItemIndex := GetImageFormat(OpenDialog.Filename);
  129.  
  130. {Set OpenDialog Control [Common Dialog Control] to the Same Index as the 'ComboBox'
  131. - this is just making sure that the ComboBox and the OpenDialog box Index's remain
  132. in Sync}
  133. OpenDialog.FilterIndex := ImageType.ItemIndex + 1;                   {Must add 1}
  134.  
  135. {Call procedure below to set the various load options based on user selections -
  136. See Below}
  137. SetLoadModes(Picbuf1);
  138.  
  139. {Set the FileName}
  140. Picbuf1.Filename:=OpenDialog.Filename;
  141.  
  142. {Load the Image}
  143. Picbuf1.Load;
  144. end;
  145. end;
  146.  
  147. {-------------------------------------------------------------------------------}
  148. {This event is similar to the above. With the exception that we use the CallBack
  149. Method. You will see that we use one extra function called 'ValidCallBack' -
  150. See Below.  This Extra Step is to check that a Valid Call Back file 'type' is being
  151. loaded.  The function returns True/False.}
  152. procedure TForm1.LoadImagewithCallBacks1Click(Sender: TObject);
  153. begin
  154. if OpenDialog.Execute then
  155. begin
  156. {Catch up}
  157. Application.ProcessMessages;
  158.  
  159. {Set 'ImageType' & 'Combobox' to reflect the extension of the selected file - this
  160. uses the procedure called 'GetImageFormat' - See Below. This is in case the user
  161. types in a file extension when the dialog is being displayed.}
  162. ImageType.ItemIndex := GetImageFormat(OpenDialog.Filename);
  163.  
  164. {Set OpenDialog Control [Common Dialog Control] to the Same Index as the 'ComboBox'
  165. - this is just making sure that the ComboBox and the OpenDialog box Index's remain
  166. in Sync}
  167. OpenDialog.FilterIndex := GetImageFormat(OpenDialog.Filename) + 1;
  168.  
  169. {Call Procedure below to set the various load options based on user selections -
  170. See Below}
  171. SetLoadModes(Picbuf1);
  172.  
  173. {Set FileName}
  174. Picbuf1.Filename:=OpenDialog.Filename;
  175.  
  176. {Use function below to check and see that the file type is compatible with CallBacks
  177. - the function evaluates to true if a valid FileFormat is passed to it. Note:-
  178. You must pass an Integer to the function, we can use the Imageformat of the Picbuf.
  179. Also note that you must set the Image format prior to using this function}
  180. if ValidCallBack(Picbuf1.ImageFormat) then
  181. begin
  182. {Activate the Load Method - Must pass the Picbuf as an .OLEOBJECT }
  183.   PicBuf1.CallbackLines := 2;
  184.   Picbuf1.LoadCallback(PicBuf1.OLEObject)
  185. end
  186. else
  187. begin
  188.   MessageDlg('Please select a [GIF JPG or PNG] file type for callback functions.', mtConfirmation, [mbOK], 0);
  189. end;
  190. BarMaxChange(Sender);       {After Completion force Progress bar to Max Position}
  191. end;
  192. end;
  193.  
  194.  
  195. {-------------------------------------------------------------------------------}
  196. {Load Button Simply Calls the FileLoad Menu Item event}
  197. procedure TForm1.LoadButtonClick(Sender: TObject);
  198. begin
  199. LoadImage1Click(Sender);
  200. end;
  201.  
  202. {-------------------------------------------------------------------------------}
  203. {Load With Call Back Buttons Simply Calls the FileLoad Menu Item event}
  204. procedure TForm1.LoadCallbackButtonClick(Sender: TObject);
  205. begin
  206. LoadImagewithCallBacks1Click(Sender);
  207. end;
  208.  
  209.  
  210. {-------------------------------------------------------------------------------}
  211. {When the user picks a filetype, set the OpenDialog default Index to the same value.
  212. This means that the OpenDialog box appears with the correct file extension selected}
  213. procedure TForm1.ImageTypeClick(Sender: TObject);
  214. begin
  215. with ImageType do                                                      {ComboBox}
  216. OpenDialog.FilterIndex := ItemIndex + 1;      {Set FilterIndex to ComboBox Index}
  217. end;
  218.  
  219.  
  220. {-------------------------------------------------------------------------------}
  221. {This Procedure is used to set a 'Picbufs' Load Options. To use it simply call the
  222. function, passing the name of the Picbuf you wish to set -
  223.  
  224. - SetloadModes(MyPicbuf);
  225.  
  226. Notice the use of 'With SETPICBUF do..Begin'.  From that point on you need make no
  227. further reference to the Picbuf.  You need just reference the properties you
  228. wish to set.}
  229. procedure SetLoadModes(SetPicbuf:TPicbuf);{Refer to this name within the procedure}
  230. begin
  231. with SetPicbuf do   {Reference Picbuf - this is the Picbuf sent to the Procedure}
  232. begin
  233. ImageFormat:=Form1.ImageType.ItemIndex;                         {SetImage Format}
  234. ImageNumber:=Form1.ImageNumber.Value;                          {Set Image Number}
  235. LoadOptions:=Form1.LoadOption.ItemIndex;                               {Fif Load}
  236. LoadScale:=Form1.LoadScale.ItemIndex;                                 {Fif Scale}
  237. LoadWidth:=Form1.LoadWidth.Value;                                     {Fif Width}
  238. LoadHeight:=Form1.LoadWidth.Value;                                   {Fif Height}
  239. end;
  240. end;
  241.  
  242.  
  243. {-------------------------------------------------------------------------------}
  244. {This Function returns the Integer format number of a given file name. Pass any
  245. file path and name to the function and it will return the ImageFormat Number.
  246. Note the use of 'Result'.  Any function you create by default has an in-built
  247. 'Result' variable.  So when you call a function your result is automatically
  248. available for use.
  249.  
  250. For example:-
  251.  
  252. ImageType.ItemIndex := GetImageFormat(OpenDialog.Filename);
  253.  
  254. The above sets the ItemIndex to the value as returned by the function.  Note how we
  255. pass the function a string - eg a 'FileName' returned by a Common Dialog Control}
  256. function GetImageFormat(FileName:String):Integer;
  257. Var
  258. Temp:String;
  259. begin
  260. Temp := UpperCase(Filename);{Convert FileName to Upper Case}
  261. Result:=0;{Default result if no recognised match is found - *.*}
  262. if Pos('.TIF', Temp ) > 0 then Result:= 1;
  263. if Pos('.TGA', Temp ) > 0 then Result:= 2;
  264. if Pos('.BMP', Temp ) > 0 then Result:= 3;
  265. if Pos('.GIF', Temp ) > 0 then Result:= 4;
  266. if Pos('.DIB', Temp ) > 0 then Result:= 5;
  267. if Pos('.PCX', Temp ) > 0 then Result:= 6;
  268. if Pos('.JPG', Temp ) > 0 then Result:= 7;
  269. if Pos('.MSP', Temp ) > 0 then Result:= 8;
  270. if Pos('.FIF', Temp ) > 0 then Result:= 9;
  271. if Pos('.PNG', Temp ) > 0 then Result:= 10;
  272. end;
  273.  
  274. {-------------------------------------------------------------------------------}
  275. {Pass any integer value, and the function returns true if it is a valid file.
  276. For our demo above pass the Picbufs ImageFormat Property  - If the set format
  277. can be used with 'CallBacks' the function returns true.}
  278. function ValidCallBack(ImageFormatIndex:Integer):Boolean;
  279. begin
  280. Result:=False;                                     {Default is False - Non Valid}
  281. if ImageFormatIndex = 4 then Result := True;                                {GIF}
  282. if ImageFormatIndex = 7 then Result := True;                                {JPG}
  283. if ImageFormatIndex = 9 then Result := True;                               {PNG}
  284. if ImageFormatIndex = 10 then Result := True;                               {PNG}
  285. end;
  286.  
  287. {-------------------------------------------------------------------------------}
  288. {This event is triggered by the picbuf control - lines represents the Image line
  289. number being processed} 
  290. procedure TForm1.Picbuf1Callback(Sender: TObject; var Lines: Smallint);
  291. begin
  292. try {catch exceptions}
  293.   LineNumber.Caption:=InttoStr(lines);    {Update Label Caption to the Line Number}
  294.   ProgressBar.Position:=Lines;                                {Update Progress Bar}
  295.   Form1.Update;
  296.   Application.ProcessMessages;                                       {Paint Screen}
  297. except
  298. end;
  299. end;
  300.  
  301. {-------------------------------------------------------------------------------}
  302. {For the Purposes of the Demo, you should set the number of lines within the Image
  303. you are loading using CallBack, if you wish the Status bar to read correctly from
  304. 0 to 100% Complete. For Normal operation you set the Max Value equal to the
  305. Y - Resolution of the Image to be Loaded}
  306. procedure TForm1.BarMaxChange(Sender: TObject);
  307. begin
  308. try
  309. ProgressBar.Max := BarMax.Value;    {Set Max or 100% Reading of the progress bar}
  310. ProgressBar.Position := BarMax.Value;                  {Set Bar to 100% position}
  311. except
  312. end;
  313. end;
  314.  
  315. {-------------------------------------------------------------------------------}
  316. {Exit Application}
  317. procedure TForm1.Exit1Click(Sender: TObject);
  318. begin
  319. Halt;
  320. end;
  321.  
  322. procedure TForm1.FormActivate(Sender: TObject);
  323. begin
  324.   PicBuf1.Scrollbars := SB_Both;
  325. end;
  326.  
  327. end.
  328.