home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / delphi2.shr / UFRSTPRO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-01  |  5.0 KB  |  148 lines
  1. {  Project FRSTPRO.DPR Delphi 2.0 Demos
  2.  
  3.    Description:- FRSTPRO.Dpr Project:-
  4.  
  5.    Demonstrates the use of:
  6.  
  7.    1) 'FileName'
  8.    2) 'Load'
  9.  
  10.    Date of Origin: 15/04/96
  11.    Original Author: Andrew Hutchison
  12.    Modification History:
  13.  
  14.    Date        Person                            Change
  15.    ----------------------------------------------------
  16.    15/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 UFrstPro;
  25.  
  26. interface
  27.  
  28. uses
  29.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  30.   Menus, OleCtrls, ImageKnife32, ExtCtrls;
  31.  
  32. type
  33.   TForm1 = class(TForm)
  34.     Picbuf1: TPicbuf;
  35.     MainMenu1: TMainMenu;
  36.     File1: TMenuItem;
  37.     Exit: TMenuItem;
  38.     Bevel1: TBevel;
  39.     Open: TMenuItem;
  40.     OpenDialog: TOpenDialog;
  41.     procedure ExitClick(Sender: TObject);
  42.     procedure Picbuf1Click(Sender: TObject);
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure OpenClick(Sender: TObject);
  45.   private
  46.     { Private declarations }
  47.   public
  48.     { Public declarations }
  49.   end;
  50.  
  51. var
  52.   Form1: TForm1;
  53.  
  54. {Additional function added for Demo Only}
  55. function GetImageLocation:String;
  56.  
  57. implementation
  58.  
  59. {$R *.DFM}
  60.  
  61.  
  62. {-------------------------------------------------------------------------------}
  63. {Load Image - Picbuf1 'Click Event'}
  64. {Load an Image when you click the Image.  For the demo program check to see if the
  65. 'default' Image exists, if it does load it, if not warn the user. For this Demo, the
  66. only steps required to load an Image are:-
  67.  
  68. 1) Set the 'FileName', this includes the full path and extension ie:- C:\Test.tif
  69.  
  70. Picbuf1.FileName:= 'C:\Test.tif';
  71.  
  72. 2) Call the 'Load Method' of the Picbuf Control
  73.  
  74. Picbuf1.Load;
  75.  
  76. That's all. The Image is then loaded.
  77.  
  78. The remainder of the code below is for the demo program only and is used to see
  79. if Media Architects test Images exist. Please Note that the Demo(s) program must be
  80. run from its default directory as set by the MAI setup program ie
  81. \....\Samples\Delphi2\FrstPro.exe and the test Image must be \....\Samples\Images\
  82. marybeth.tif}
  83.  
  84. {-------------------------------------------------------------------------------}
  85. {Load the Image when the users clicks the Image with the mouse}
  86. procedure TForm1.Picbuf1Click(Sender: TObject);
  87. begin
  88. {Load Default Image if they exist - for Demo only - not normally used}
  89. if FileExists(GetImageLocation + 'images\marybeth.tif') then
  90. begin                                                                {Does Exist}
  91. {Set Picbuf1's 'FileName' to required File - Full Path}
  92. Picbuf1.Filename := GetImageLocation + 'images\marybeth.tif';
  93. {Call 'Standard Load Method' after setting file name}
  94. Picbuf1.Load;
  95. end                                                              {Does Not Exist}
  96. {This causes a 'Messagebox' to appear if the 'Demo Image' is not found}
  97. else
  98. MessageDlg('Cannot find sample file [\...\Images\Marybeth.tif].' +
  99. ' Users must place this file into the above directory.', mtInformation,
  100. [mbOk], 0);
  101. end;
  102.  
  103. {-------------------------------------------------------------------------------}
  104. {Simply Exits the Project}
  105. procedure TForm1.ExitClick(Sender: TObject);
  106. begin
  107. Halt;                                                           {Close All Forms}
  108. end;
  109.  
  110. {-------------------------------------------------------------------------------}
  111. {Open a file based on extension - called by 'File menu'}
  112. procedure TForm1.OpenClick(Sender: TObject);
  113. begin
  114. {Show a CommonDialog Control - Open the file if OK selected}
  115. If OpenDialog.execute then
  116.  begin
  117.  {Set Filename of Picbuf to desired file}
  118.  Picbuf1.Filename:=OpenDialog.Filename;
  119.  {Call Standard Method to Load the Image - based on extension};
  120.  Picbuf1.Load;
  121.  end;
  122. end;
  123.  
  124. {-------------------------------------------------------------------------------}
  125. {Set up any defaults required on the form Create Event}
  126. procedure TForm1.FormCreate(Sender: TObject);
  127. begin
  128. Application.HintPause:=10;                                       {Set Hint Delay}
  129. Application.HintColor:=ClAqua;                                  {Set Hint Colour}
  130. end;
  131.  
  132. {-------------------------------------------------------------------------------}
  133. {Get Path of Default test files:-
  134. Basically the functions gets the path name of the EXE location, strips of the last
  135. directory, ready for use - only applicable to this Demo}
  136. function GetImageLocation:String;
  137. Var
  138. Temp:String;
  139. DelphiLocation:Integer;
  140. begin
  141. Temp := ExtractFileDir(Application.exename);               {Get full path of EXE}
  142. Temp := UpperCase(Temp);                             {Make Sure it is upper Case}
  143. DelphiLocation := Pos('\DELPHI2',Temp);
  144. Delete(Temp,DelphiLocation,length('\DELPHI2'));         {Strip of last Directory}
  145. Result:=Temp + '\';                                         {Add the Missing '\'}
  146. end;
  147. end.
  148.