home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / delphi2.shr / UINFO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-01  |  4.8 KB  |  160 lines
  1.   {  Project Info.DPR Delphi 2.0 Demos
  2.  
  3.    Description:- Info.Dpr Project:-
  4.  
  5.    Demonstrates the use of:
  6.  
  7.    1) 'Xresolution'
  8.    2) 'Yresolution'
  9.    3) 'ColorDepth'
  10.    4) 'GetPalColor'
  11.    5) 'GetPalIndex'
  12.    6) 'GetColor'
  13.  
  14.    Date of Origin: 15/04/96
  15.    Original Author: Andrew Hutchison
  16.    Modification History:
  17.  
  18.    Date        Person                            Change
  19.    ----------------------------------------------------
  20.    15/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 UInfo;
  29.  
  30. interface
  31.  
  32. uses
  33.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  34.   StdCtrls, OleCtrls, ImageKnife32, ExtCtrls, Menus;
  35.  
  36. type
  37.   TForm1 = class(TForm)
  38.     MainMenu1: TMainMenu;
  39.     File1: TMenuItem;
  40.     LoadImage: TMenuItem;
  41.     N1: TMenuItem;
  42.     Exit: TMenuItem;
  43.     Bevel1: TBevel;
  44.     Picbuf1: TPicbuf;
  45.     GroupBox1: TGroupBox;
  46.     GroupBox2: TGroupBox;
  47.     Label1: TLabel;
  48.     Label2: TLabel;
  49.     Label3: TLabel;
  50.     Label4: TLabel;
  51.     Label5: TLabel;
  52.     Label6: TLabel;
  53.     Label7: TLabel;
  54.     Label8: TLabel;
  55.     Shape: TShape;
  56.     Xpos: TLabel;
  57.     Ypos: TLabel;
  58.     Width: TLabel;
  59.     Height: TLabel;
  60.     BitDepth: TLabel;
  61.     Color: TLabel;
  62.     PalIndex: TLabel;
  63.     PalColor: TLabel;
  64.     OpenDialog: TOpenDialog;
  65.     procedure Picbuf1MouseMove(Sender: TObject; Shift: TShiftState; X,
  66.       Y: Integer);
  67.     procedure Picbuf1MouseDown(Sender: TObject; Button: TMouseButton;
  68.       Shift: TShiftState; X, Y: Integer);
  69.     procedure LoadImageClick(Sender: TObject);
  70.     procedure ExitClick(Sender: TObject);
  71.     procedure FormCreate(Sender: TObject);
  72.     procedure FormActivate(Sender: TObject);
  73.   private
  74.     { Private declarations }
  75.   public
  76.     { Public declarations }
  77.   end;
  78.  
  79. var
  80.   Form1: TForm1;
  81.  
  82. implementation
  83.  
  84. {$R *.DFM}
  85.  
  86.  
  87. {-------------------------------------------------------------------------------}
  88. {Update all captions connected with a Mouse Move Event.  Always use calls that
  89. can be converted to a Valid Caption}
  90. procedure TForm1.Picbuf1MouseMove(Sender: TObject; Shift: TShiftState; X,
  91.   Y: Integer);
  92. begin
  93. {Trap all Non Valid Options}
  94. try
  95.  {Set X and Y Label Captions - Reflects Mouse Location over Image}
  96.  XPos.Caption := inttostr (Picbuf1.ScreenToImageX(X));
  97.  YPos.Caption := inttostr (Picbuf1.ScreenToImageY(Y));
  98. {Update all Lables using appropriate IK Calls}
  99. if Picbuf1.ColorDepth = 24 then
  100.  Color.Caption:= inttostr(Picbuf1.Getcolor(Picbuf1.ScreenToImageX(X),Picbuf1.ScreenToImageY(Y)))
  101. else                                           {Any Bit depth other than 24 Bit}
  102.  begin
  103.  PalIndex.Caption:=inttostr(Picbuf1.GetPalIndex(Picbuf1.ScreenToImageX(X),Picbuf1.ScreenToImageY(Y)));
  104.  PalColor.Caption:=inttostr(Picbuf1.GetPalColor(Picbuf1.GetPalIndex(Picbuf1.ScreenToImageX(X),Picbuf1.ScreenToImageY(Y))));
  105.  Color.Caption:= inttostr(Picbuf1.GetColor(Picbuf1.ScreenToImageX(X),Picbuf1.ScreenToImageY(Y)));
  106.  end;
  107. except
  108. end;
  109. end;
  110.  
  111.  
  112. {-------------------------------------------------------------------------------}
  113. {Update Color swatch Uusing a Mouse Down event}
  114. procedure TForm1.Picbuf1MouseDown(Sender: TObject; Button: TMouseButton;
  115.   Shift: TShiftState; X, Y: Integer);
  116. begin
  117. With Shape.Brush do                                       {Reference Shape.Brush}
  118. Color:= Picbuf1.GetColor(Picbuf1.ScreenToImageX(X),Picbuf1.ScreenToImageY(Y));
  119. end;
  120.  
  121.  
  122. {-------------------------------------------------------------------------------}
  123. {Load Image using Standard Control}
  124. procedure TForm1.LoadImageClick(Sender: TObject);
  125. begin
  126. if OpenDialog.Execute then                                    {Reference Control}
  127. begin
  128. Picbuf1.FileName:=OpenDialog.FileName;                             {Set FileName}
  129. Picbuf1.Load;                                                         {Call Load}
  130. Width.Caption:=inttostr(Picbuf1.Xresolution);                           {Caption}
  131. Height.Caption:=inttostr(Picbuf1.Yresolution);                          {Caption}
  132. BitDepth.Caption:=inttostr(Picbuf1.ColorDepth);                         {Caption}
  133. end;
  134. end;
  135.  
  136.  
  137. {-------------------------------------------------------------------------------}
  138. {Close Project Down}
  139. procedure TForm1.ExitClick(Sender: TObject);
  140. begin
  141. Halt;
  142. end;
  143.  
  144.  
  145. {-------------------------------------------------------------------------------}
  146. {Set Defaults}
  147. procedure TForm1.FormCreate(Sender: TObject);
  148. begin
  149. Application.HintPause:=10;
  150. Application.HintColor:=clAqua;
  151. end;
  152.  
  153. procedure TForm1.FormActivate(Sender: TObject);
  154. begin
  155.   PicBuf1.Filename := '..\images\marybeth.tif';
  156.   PicBuf1.Load;
  157. end;
  158.  
  159. end.
  160.