home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / IMAGPRVW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  8.2 KB  |  293 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit ImagPrvw;
  12.  
  13. interface
  14.  
  15. {$I RX.INC}
  16.  
  17. uses SysUtils, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  18.   Classes, Graphics, Forms, Controls, FileCtrl, StdCtrls, ExtCtrls, Buttons,
  19.   RxCtrls, PicClip, Placemnt, ObjStr;
  20.  
  21. type
  22.   TImageForm = class(TForm)
  23.     DirectoryList: TDirectoryListBox;
  24.     DriveCombo: TDriveComboBox;
  25.     PathLabel: TLabel;
  26.     FileEdit: TEdit;
  27.     ImagePanel: TPanel;
  28.     Image: TImage;
  29.     FileListBox: TFileListBox;
  30.     ImageName: TLabel;
  31.     FilterCombo: TFilterComboBox;
  32.     StretchCheck: TCheckBox;
  33.     FilePics: TPicClip;
  34.     FormStorage: TFormStorage;
  35.     OkBtn: TButton;
  36.     CancelBtn: TButton;
  37.     Label2: TLabel;
  38.     Label3: TLabel;
  39.     Label4: TLabel;
  40.     Label5: TLabel;
  41.     PreviewBtn: TRxSpeedButton;
  42.     procedure FileListBoxClick(Sender: TObject);
  43.     procedure StretchCheckClick(Sender: TObject);
  44.     procedure FormCreate(Sender: TObject);
  45.     procedure FileListBoxChange(Sender: TObject);
  46.     procedure FileListBoxDblClick(Sender: TObject);
  47.     procedure FormDestroy(Sender: TObject);
  48.     procedure PreviewBtnClick(Sender: TObject);
  49.     procedure OkBtnClick(Sender: TObject);
  50.   private
  51.     FormCaption: string;
  52.     FBmpImage: TBitmap;
  53.     procedure ZoomImage;
  54.     function GetFileName: string;
  55.     procedure SetFileName(const Value: string);
  56.     procedure PreviewKeyPress(Sender: TObject; var Key: Char);
  57.   public
  58.     property FileName: string read GetFileName write SetFileName;
  59.   end;
  60.  
  61. function SelectImage(var AFileName: string; const Extensions,
  62.   Filter: string): Boolean;
  63.  
  64. implementation
  65.  
  66. uses Consts, MaxMin, RxConst, VCLUtils, RxGraph;
  67.  
  68. {$R *.DFM}
  69.  
  70. {$I+}
  71. {$IFDEF WIN32}
  72.  {$D-}
  73. {$ENDIF}
  74.  
  75. const
  76.   SAllFiles = 'All files';
  77.   SPreview = 'Preview';
  78.  
  79. function SelectImage(var AFileName: string; const Extensions,
  80.   Filter: string): Boolean;
  81. var
  82.   ErrMode: Cardinal;
  83. begin
  84.   with TImageForm.Create(Application) do
  85.   try
  86.     FileListBox.Mask := Extensions;
  87.     FilterCombo.Filter := Filter;
  88.     if Pos('*.*', Filter) = 0 then begin
  89.       if Length(Filter) > 0 then FilterCombo.Filter := Filter + '|';
  90.       FilterCombo.Filter := FilterCombo.Filter + SAllFiles + ' (*.*)|*.*';
  91.     end;
  92.     ErrMode := SetErrorMode(SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS);
  93.     try
  94.       if AFileName <> '' then FileName := AFileName;
  95.       Result := ShowModal = mrOk;
  96.     finally
  97.       SetErrorMode(ErrMode);
  98.     end;
  99.     if Result then AFileName := FileName;
  100.   finally
  101.     Free;
  102.   end;
  103. end;
  104.  
  105. type
  106.   TDirList = class(TDirectoryListBox);
  107.   TFileList = class(TFileListBox);
  108.   TDriveCombo = class(TDriveComboBox);
  109.  
  110. function ValidPicture(Pict: TPicture): Boolean;
  111. begin
  112.   Result := (Pict.Graphic <> nil) and not (Pict.Graphic.Empty) and
  113.     (Pict.Width > 0) and (Pict.Height > 0);
  114. end;
  115.  
  116. { TImageForm }
  117.  
  118. function TImageForm.GetFileName: string;
  119. begin
  120.   Result := FileListBox.FileName;
  121. end;
  122.  
  123. procedure TImageForm.SetFileName(const Value: string);
  124. begin
  125.   FileListBox.FileName := Value;
  126. end;
  127.  
  128. procedure TImageForm.ZoomImage;
  129. begin
  130.   if ValidPicture(Image.Picture) then begin
  131.     with RxGraph.ZoomImage(Image.Picture.Width, Image.Picture.Height,
  132.       ImagePanel.ClientWidth - 4, ImagePanel.ClientHeight - 4,
  133.       StretchCheck.Checked) do
  134.     begin
  135.       Image.Width := X;
  136.       Image.Height := Y;
  137.     end;
  138.     CenterControl(Image);
  139.   end;
  140. end;
  141.  
  142. procedure TImageForm.FileListBoxClick(Sender: TObject);
  143. var
  144.   FileExt: string;
  145. begin
  146.   FileExt := UpperCase(ExtractFileExt(FileListBox.Filename));
  147.   try
  148.     StartWait;
  149.     try
  150.       Image.Picture.LoadFromFile(FileListBox.Filename);
  151.     finally
  152.       StopWait;
  153.     end;
  154.     ImageName.Caption := Format('%s (%d x %d)',
  155.       [AnsiLowerCase(ExtractFilename(FileListBox.Filename)),
  156.       Image.Picture.Width, Image.Picture.Height]);
  157.   except
  158.     Image.Picture.Assign(nil);
  159.     ImageName.Caption := '';
  160.   end;
  161.   ZoomImage;
  162.   FileExt := AnsiLowerCase(FileName);
  163.   if FileExt <> '' then
  164.     Caption := FormCaption + ' - ' + MinimizeName(FileExt, PathLabel.Canvas,
  165.       PathLabel.Width)
  166.   else Caption := FormCaption;
  167.   PreviewBtn.Enabled := ValidPicture(Image.Picture);
  168. end;
  169.  
  170. procedure TImageForm.StretchCheckClick(Sender: TObject);
  171. begin
  172.   ZoomImage;
  173.   Image.Stretch := StretchCheck.Checked;
  174. end;
  175.  
  176. procedure TImageForm.FormCreate(Sender: TObject);
  177. begin
  178.   FormCaption := Caption;
  179.   Image.Align := alNone;
  180.   FBmpImage := TBitmap.Create;
  181.   FBmpImage.Assign(FilePics.GraphicCell[5]);
  182.   if not NewStyleControls then Font.Style := [fsBold];
  183. {$IFDEF WIN32}
  184.   with FormStorage do begin
  185.     UseRegistry := True;
  186.     IniFileName := SDelphiKey;
  187.   end;
  188. {$ENDIF}
  189.   with TDirList(DirectoryList) do begin
  190.     ClosedBmp.Assign(FilePics.GraphicCell[0]);
  191.     OpenedBmp.Assign(FilePics.GraphicCell[1]);
  192.     CurrentBmp.Assign(FilePics.GraphicCell[2]);
  193.   end;
  194.   with TFileList(FileListBox) do begin
  195.     DirBmp.Assign(FilePics.GraphicCell[0]);
  196.     ExeBmp.Assign(FilePics.GraphicCell[3]);
  197.     UnknownBmp.Assign(FilePics.GraphicCell[4]);
  198.   end;
  199.   with TDriveCombo(DriveCombo) do begin
  200.     FloppyBMP.Assign(FilePics.GraphicCell[6]);
  201.     FixedBMP.Assign(FilePics.GraphicCell[7]);
  202.     CDROMBMP.Assign(FilePics.GraphicCell[8]);
  203.     NetworkBMP.Assign(FilePics.GraphicCell[9]);
  204.     RAMBMP.Assign(FilePics.GraphicCell[10]);
  205.   end;
  206.   FileListBoxChange(nil);
  207.   TComboBox(FilterCombo).ItemHeight := Max(TComboBox(FilterCombo).ItemHeight,
  208.     FilePics.Height);
  209.   TComboBox(DriveCombo).ItemHeight := Max(TComboBox(FilterCombo).ItemHeight,
  210.     FilePics.Height);
  211.   TFileList(FileListBox).ItemHeight := Max(TFileList(FileListBox).ItemHeight,
  212.     FilePics.Height + 1);
  213.   TFileList(FileListBox).ItemHeight := Max(TFileList(FileListBox).ItemHeight,
  214.     FilePics.Height + 1);
  215.   DirectoryList.Height := FileListBox.Height;
  216. end;
  217.  
  218. procedure TImageForm.FileListBoxChange(Sender: TObject);
  219. var
  220.   I: Integer;
  221.   FileExt: string;
  222. begin
  223.   for I := 0 to TFileList(FileListBox).Items.Count - 1 do begin
  224.     FileExt := ExtractFileExt(TFileList(FileListBox).Items[I]);
  225.     if (TFileList(FileListBox).Items[I][1] <> '[') and
  226.       (CompareText(FileExt, '.bmp') = 0) then
  227.       TFileList(FileListBox).Items.Objects[I] := FBmpImage;
  228.   end;
  229. end;
  230.  
  231. procedure TImageForm.FileListBoxDblClick(Sender: TObject);
  232. begin
  233.   if ValidPicture(Image.Picture) then ModalResult := mrOk;
  234. end;
  235.  
  236. procedure TImageForm.FormDestroy(Sender: TObject);
  237. begin
  238.   FBmpImage.Free;
  239.   FBmpImage := nil;
  240. end;
  241.  
  242. procedure TImageForm.PreviewKeyPress(Sender: TObject; var Key: Char);
  243. begin
  244.   if Key = #27 then TForm(Sender).Close;
  245. end;
  246.  
  247. procedure TImageForm.PreviewBtnClick(Sender: TObject);
  248. var
  249.   PreviewForm: TForm;
  250. begin
  251.   if not ValidPicture(Image.Picture) then Exit;
  252. {$IFDEF CBUILDER}
  253.   PreviewForm := TForm.CreateNew(Self, 0);
  254. {$ELSE}
  255.   PreviewForm := TForm.CreateNew(Self);
  256. {$ENDIF}
  257.   with PreviewForm do
  258.   try
  259.     Caption := SPreview;
  260. {$IFDEF WIN32}
  261.     BorderStyle := bsSizeToolWin;
  262. {$ELSE}
  263.     BorderIcons := [biSystemMenu];
  264. {$ENDIF}
  265.     Icon := Self.Icon;
  266.     KeyPreview := True;
  267.     Position := poScreenCenter;
  268.     OnKeyPress := PreviewKeyPress;
  269.     with TImage.Create(PreviewForm) do begin
  270.       Left := 0; Top := 0;
  271.       Stretch := False;
  272.       AutoSize := True;
  273.       Picture.Assign(Image.Picture);
  274.       Parent := PreviewForm;
  275.     end;
  276.     if Image.Picture.Width > 0 then begin
  277.       ClientWidth := Image.Picture.Width;
  278.       ClientHeight := Image.Picture.Height;
  279.     end;
  280.     ShowModal;
  281.   finally
  282.     Free;
  283.   end;
  284. end;
  285.  
  286. procedure TImageForm.OkBtnClick(Sender: TObject);
  287. begin
  288.   if (ActiveControl = FileEdit) then FileListBox.ApplyFilePath(FileEdit.Text)
  289.   else if ValidPicture(Image.Picture) then ModalResult := mrOk
  290.   else Beep;
  291. end;
  292.  
  293. end.