home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Demos / Imagview / IMAGEWIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  4.3 KB  |  160 lines
  1. unit ImageWin;
  2.  
  3. interface
  4.  
  5. uses Windows, Classes, Graphics, Forms, Controls,
  6.   FileCtrl, StdCtrls, ExtCtrls, Buttons, Spin, ComCtrls, Dialogs;
  7.  
  8. type
  9.   TImageForm = class(TForm)
  10.     DirectoryListBox1: TDirectoryListBox;
  11.     DriveComboBox1: TDriveComboBox;
  12.     FileEdit: TEdit;
  13.     UpDownGroup: TGroupBox;
  14.     SpeedButton1: TSpeedButton;
  15.     BitBtn1: TBitBtn;
  16.     DisabledGrp: TGroupBox;
  17.     SpeedButton2: TSpeedButton;
  18.     BitBtn2: TBitBtn;
  19.     Panel1: TPanel;
  20.     Image1: TImage;
  21.     FileListBox1: TFileListBox;
  22.     Label2: TLabel;
  23.     ViewBtn: TBitBtn;
  24.     Bevel1: TBevel;
  25.     Bevel2: TBevel;
  26.     FilterComboBox1: TFilterComboBox;
  27.     GlyphCheck: TCheckBox;
  28.     StretchCheck: TCheckBox;
  29.     UpDownEdit: TEdit;
  30.     UpDown1: TUpDown;
  31.     procedure FileListBox1Click(Sender: TObject);
  32.     procedure ViewBtnClick(Sender: TObject);
  33.     procedure ViewAsGlyph(const FileExt: string);
  34.     procedure GlyphCheckClick(Sender: TObject);
  35.     procedure StretchCheckClick(Sender: TObject);
  36.     procedure FileEditKeyPress(Sender: TObject; var Key: Char);
  37.     procedure UpDownEditChange(Sender: TObject);
  38.     procedure FormCreate(Sender: TObject);
  39.   private
  40.     FormCaption: string;    
  41.   end;
  42.  
  43. var
  44.   ImageForm: TImageForm;
  45.  
  46. implementation
  47.  
  48. uses ViewWin, SysUtils;
  49.  
  50. {$R *.DFM}
  51.  
  52. procedure TImageForm.FileListBox1Click(Sender: TObject);
  53. var
  54.   FileExt: string[4];
  55. begin
  56.   FileExt := AnsiUpperCase(ExtractFileExt(FileListBox1.Filename));
  57.   if (FileExt = '.BMP') or (FileExt = '.ICO') or (FileExt = '.WMF') or
  58.     (FileExt = '.EMF') then
  59.   begin
  60.     Image1.Picture.LoadFromFile(FileListBox1.Filename);
  61.     Caption := FormCaption + ExtractFilename(FileListBox1.Filename);
  62.     if (FileExt = '.BMP') then
  63.     begin
  64.       Caption := Caption + 
  65.         Format(' (%d x %d)', [Image1.Picture.Width, Image1.Picture.Height]);
  66.       ViewForm.Image1.Picture := Image1.Picture;
  67.       ViewForm.Caption := Caption;
  68.       if GlyphCheck.Checked then ViewAsGlyph(FileExt);
  69.     end
  70.     else
  71.       GlyphCheck.Checked := False;
  72.     if FileExt = '.ICO' then
  73.     begin
  74.       Icon := Image1.Picture.Icon;
  75.       ViewForm.Image1.Picture.Icon := Icon;
  76.     end;
  77.     if (FileExt = '.WMF') or (FileExt = '.EMF') then 
  78.       ViewForm.Image1.Picture.Metafile := Image1.Picture.Metafile;
  79.   end;
  80. end;
  81.  
  82. procedure TImageForm.GlyphCheckClick(Sender: TObject);
  83. begin
  84.   ViewAsGlyph(AnsiUpperCase(ExtractFileExt(FileListBox1.Filename)));
  85. end;
  86.  
  87. procedure TImageForm.ViewAsGlyph(const FileExt: string);
  88. begin
  89.   if GlyphCheck.Checked and (FileExt = '.BMP') then 
  90.   begin
  91.     SpeedButton1.Glyph := Image1.Picture.Bitmap;
  92.     SpeedButton2.Glyph := Image1.Picture.Bitmap;
  93.     UpDown1.Position := SpeedButton1.NumGlyphs;
  94.     BitBtn1.Glyph := Image1.Picture.Bitmap;
  95.     BitBtn2.Glyph := Image1.Picture.Bitmap;
  96.   end
  97.   else begin
  98.     SpeedButton1.Glyph := nil;
  99.     SpeedButton2.Glyph := nil;
  100.     BitBtn1.Glyph := nil;
  101.     BitBtn2.Glyph := nil;
  102.   end;
  103.   UpDown1.Enabled := GlyphCheck.Checked;
  104.   UpDownEdit.Enabled := GlyphCheck.Checked;
  105.   Label2.Enabled := GlyphCheck.Checked;
  106. end;
  107.  
  108. procedure TImageForm.ViewBtnClick(Sender: TObject);
  109. begin
  110.   ViewForm.HorzScrollBar.Range := Image1.Picture.Width;
  111.   ViewForm.VertScrollBar.Range := Image1.Picture.Height;
  112.   ViewForm.Caption := Caption;
  113.   ViewForm.Show;
  114.   ViewForm.WindowState := wsNormal;
  115. end;
  116.  
  117. procedure TImageForm.UpDownEditChange(Sender: TObject);
  118. resourcestring
  119.   sMinValue = 'Value below minimum';
  120.   sMaxValue = 'Value over maximum';
  121.  
  122. begin
  123.   if (StrToInt(UpDownEdit.Text) < UpDown1.Min) then
  124.   begin
  125.     UpDownEdit.Text := '1';
  126.     raise ERangeError.Create(sMinValue);
  127.   end
  128.   else if (StrToInt(UpDownEdit.Text) > UpDown1.Max) then
  129.   begin
  130.     UpDownEdit.Text := '4';
  131.     raise ERangeError.Create(sMaxValue);
  132.   end;
  133.  
  134.   SpeedButton1.NumGlyphs := UpDown1.Position;
  135.   SpeedButton2.NumGlyphs := UpDown1.Position;
  136. end;
  137.  
  138. procedure TImageForm.StretchCheckClick(Sender: TObject);
  139. begin
  140.   Image1.Stretch := StretchCheck.Checked;
  141. end;
  142.  
  143. procedure TImageForm.FileEditKeyPress(Sender: TObject; var Key: Char);
  144. begin
  145.   if Key = #13 then 
  146.   begin
  147.     FileListBox1.ApplyFilePath(FileEdit.Text);
  148.     Key := #0;
  149.   end;
  150. end;
  151.  
  152. procedure TImageForm.FormCreate(Sender: TObject);
  153. begin
  154.   FormCaption := Caption + ' - ';
  155.   UpDown1.Min := 1;
  156.   UpDown1.Max := 4;
  157. end;
  158.  
  159. end.
  160.