home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / PICTEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  21KB  |  746 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi VCL Extensions (RX)                      }
  4. {                                                       }
  5. {       Copyright (c) 1995, 1997 Borland International  }
  6. {       Portions copyright (c) 1995, 1996 AO ROSNO      }
  7. {       Portions copyright (c) 1997 Master-Bank         }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit PictEdit;
  12.  
  13. {$I RX.INC}
  14.  
  15. interface
  16.  
  17. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  18.   Messages, Classes, Graphics, Forms, Controls, Dialogs, Buttons,
  19.   RTLConsts, DesignIntf, DesignEditors, VCLEditors, StdCtrls, ExtCtrls, Placemnt, ClipMon,
  20.   {$IFDEF RX_D3} ExtDlgs, ComCtrls, {$ELSE} ImagPrvw, {$ENDIF} Menus,
  21.   MRUList, RXCtrls;
  22.  
  23. type
  24.  
  25. { TPictureEditDialog }
  26.  
  27.   TPictureEditDialog = class(TForm)
  28.     Load: TButton;
  29.     Save: TButton;
  30.     Copy: TButton;
  31.     Paste: TButton;
  32.     Clear: TButton;
  33.     OKButton: TButton;
  34.     CancelButton: TButton;
  35.     HelpBtn: TButton;
  36.     DecreaseBox: TCheckBox;
  37.     UsePreviewBox: TCheckBox;
  38.     FormStorage: TFormStorage;
  39.     GroupBox: TGroupBox;
  40.     ImagePanel: TPanel;
  41.     ImagePaintBox: TPaintBox;
  42.     Bevel: TBevel;
  43.     Paths: TButton;
  44.     PathsBtn: TRxSpeedButton;
  45.     PathsMenu: TPopupMenu;
  46.     PathsMRU: TMRUManager;
  47.     procedure FormCreate(Sender: TObject);
  48.     procedure FormDestroy(Sender: TObject);
  49.     procedure LoadClick(Sender: TObject);
  50.     procedure SaveClick(Sender: TObject);
  51.     procedure ClearClick(Sender: TObject);
  52.     procedure CopyClick(Sender: TObject);
  53.     procedure PasteClick(Sender: TObject);
  54.     procedure HelpBtnClick(Sender: TObject);
  55.     procedure FormStorageRestorePlacement(Sender: TObject);
  56.     procedure FormStorageSavePlacement(Sender: TObject);
  57.     procedure ImagePaintBoxPaint(Sender: TObject);
  58.     procedure PathsClick(Sender: TObject);
  59.     procedure PathsMRUClick(Sender: TObject; const RecentName,
  60.       Caption: string; UserData: Longint);
  61.     procedure PathsMenuPopup(Sender: TObject);
  62.     procedure PathsMRUChange(Sender: TObject);
  63.   private
  64.     FGraphicClass: TGraphicClass;
  65.     Pic: TPicture;
  66.     FIconColor: TColor;
  67.     FClipMonitor: TClipboardMonitor;
  68. {$IFDEF RX_D3}
  69.     FProgress: TProgressBar;
  70.     FProgressPos: Integer;
  71.     FileDialog: TOpenPictureDialog;
  72.     SaveDialog: TSavePictureDialog;
  73. {$ELSE}
  74.     FileDialog: TOpenDialog;
  75.     SaveDialog: TSaveDialog;
  76. {$ENDIF}
  77.     procedure CheckEnablePaste;
  78.     procedure ValidateImage;
  79.     procedure DecreaseBMPColors;
  80.     procedure SetGraphicClass(Value: TGraphicClass);
  81.     function GetDecreaseColors: Boolean;
  82.     procedure LoadFile(const FileName: string);
  83.     procedure UpdatePathsMenu;
  84.     procedure UpdateClipboard(Sender: TObject);
  85.     procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  86.     procedure WMDestroy(var Msg: TMessage); message WM_DESTROY;
  87. {$IFDEF RX_D3}
  88.     procedure GraphicProgress(Sender: TObject; Stage: TProgressStage;
  89.       PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
  90. {$ENDIF}
  91.   protected
  92.     procedure CreateHandle; override;
  93.   public
  94.     property DecreaseColors: Boolean read GetDecreaseColors;
  95.     property GraphicClass: TGraphicClass read FGraphicClass write SetGraphicClass;
  96.   end;
  97.  
  98. { TPictEditor }
  99.  
  100.   TPictEditor = class(TComponent)
  101.   private
  102.     FGraphicClass: TGraphicClass;
  103.     FPicture: TPicture;
  104.     FPicDlg: TPictureEditDialog;
  105.     FDecreaseColors: Boolean;
  106.     procedure SetPicture(Value: TPicture);
  107.     procedure SetGraphicClass(Value: TGraphicClass);
  108.   public
  109.     constructor Create(AOwner: TComponent); override;
  110.     destructor Destroy; override;
  111.     function Execute: Boolean;
  112.     property PicDlg: TPictureEditDialog read FPicDlg;
  113.     property GraphicClass: TGraphicClass read FGraphicClass write SetGraphicClass;
  114.     property Picture: TPicture read FPicture write SetPicture;
  115.   end;
  116.  
  117. { TPictProperty }
  118.  
  119. { Property editor the TPicture properties (e.g. the Picture property). Brings
  120.   up a file open dialog allowing loading a picture file. }
  121.  
  122.   TPictProperty = class(TPropertyEditor)
  123.   public
  124.     procedure Edit; override;
  125.     function GetAttributes: TPropertyAttributes; override;
  126.     function GetValue: string; override;
  127.     procedure SetValue(const Value: string); override;
  128.   end;
  129.  
  130. { TGraphicPropertyEditor }
  131.  
  132.   TGraphicPropertyEditor = class(TClassProperty)
  133.   public
  134.     procedure Edit; override;
  135.     function GetAttributes: TPropertyAttributes; override;
  136.     function GetValue: string; override;
  137.     procedure SetValue(const Value: string); override;
  138.   end;
  139.  
  140. { TGraphicsEditor }
  141.  
  142.   TGraphicsEditor = class(TDefaultEditor)
  143.   public
  144.     procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override;
  145.   end;
  146.  
  147. function EditGraphic(Graphic: TGraphic; AClass: TGraphicClass;
  148.   const DialogCaption: string): Boolean;
  149.  
  150. implementation
  151.  
  152. uses TypInfo, SysUtils, Clipbrd, Consts, ShellApi, LibHelp, ClipIcon, RxGraph,
  153.   VCLUtils, AppUtils, RxConst, RxDirFrm, FileUtil;
  154.  
  155. {$B-}
  156. {$IFDEF WIN32}
  157.  {$D-}
  158. {$ENDIF}
  159.  
  160. {$R *.DFM}
  161.  
  162. procedure CopyPicture(Pict: TPicture; BackColor: TColor);
  163. begin
  164.   if Pict.Graphic <> nil then begin
  165.     if Pict.Graphic is TIcon then CopyIconToClipboard(Pict.Icon, BackColor)
  166.     { check another specific graphic types here }
  167.     else Clipboard.Assign(Pict);
  168.   end;
  169. end;
  170.  
  171. procedure PastePicture(Pict: TPicture; GraphicClass: TGraphicClass);
  172. var
  173.   NewGraphic: TGraphic;
  174. begin
  175.   if (Pict <> nil) then begin
  176.     if Clipboard.HasFormat(CF_ICON) and ((GraphicClass = TIcon) or
  177.       (GraphicClass = TGraphic)) then
  178.     begin
  179.       NewGraphic := CreateIconFromClipboard;
  180.       if NewGraphic <> nil then
  181.         try
  182.           Pict.Assign(NewGraphic);
  183.         finally
  184.           NewGraphic.Free;
  185.         end;
  186.     end
  187.     { check another specific graphic types here }
  188.     else if Clipboard.HasFormat(CF_PICTURE) then
  189.       Pict.Assign(Clipboard);
  190.   end;
  191. end;
  192.  
  193. function EnablePaste(Graph: TGraphicClass): Boolean;
  194. begin
  195.   if (Graph = TBitmap) then Result := Clipboard.HasFormat(CF_BITMAP)
  196.   else if (Graph = TMetafile) then Result := Clipboard.HasFormat(CF_METAFILEPICT)
  197.   else if (Graph = TIcon) then Result := Clipboard.HasFormat(CF_ICON)
  198.   { check another graphic types here }
  199.   else if (Graph = TGraphic) then Result := Clipboard.HasFormat(CF_PICTURE)
  200.   else Result := Clipboard.HasFormat(CF_PICTURE);
  201. end;
  202.  
  203. function ValidPicture(Pict: TPicture): Boolean;
  204. begin
  205.   Result := (Pict.Graphic <> nil) and not Pict.Graphic.Empty;
  206. end;
  207.  
  208. { TPictEditor }
  209.  
  210. constructor TPictEditor.Create(AOwner: TComponent);
  211. begin
  212.   inherited Create(AOwner);
  213.   FPicture := TPicture.Create;
  214.   FPicDlg := TPictureEditDialog.Create(Self);
  215.   FGraphicClass := TGraphic;
  216.   FPicDlg.GraphicClass := FGraphicClass;
  217. end;
  218.  
  219. destructor TPictEditor.Destroy;
  220. begin
  221.   FPicture.Free;
  222.   inherited Destroy;
  223. end;
  224.  
  225. function TPictEditor.Execute: Boolean;
  226. var
  227.   Bmp: TBitmap;
  228.   CurDir: string;
  229. begin
  230.   FPicDlg.Pic.Assign(FPicture);
  231.   with FPicDlg.FileDialog do
  232.   begin
  233.     Options := [ofHideReadOnly, ofFileMustExist, ofShowHelp];
  234.     DefaultExt := GraphicExtension(GraphicClass);
  235.     Filter := GraphicFilter(GraphicClass);
  236.     HelpContext := hcDLoadPicture;
  237.   end;
  238.   with FPicDlg.SaveDialog do
  239.   begin
  240.     Options := [ofHideReadOnly, ofFileMustExist, ofShowHelp,
  241.       ofOverwritePrompt];
  242.     DefaultExt := GraphicExtension(GraphicClass);
  243.     Filter := GraphicFilter(GraphicClass);
  244.     HelpContext := hcDSavePicture;
  245.   end;
  246.   FPicDlg.ValidateImage;
  247.   CurDir := GetCurrentDir;
  248.   try
  249.     Result := FPicDlg.ShowModal = mrOK;
  250.   finally
  251.     SetCurrentDir(CurDir);
  252.   end;
  253.   FDecreaseColors := FPicDlg.DecreaseColors;
  254.   if Result then begin
  255.     if FPicDlg.Pic.Graphic <> nil then begin
  256.       if (GraphicClass = TBitmap) and (FPicDlg.Pic.Graphic is TIcon) then
  257.       begin
  258.         Bmp := CreateBitmapFromIcon(FPicDlg.Pic.Icon, FPicDlg.FIconColor);
  259.         try
  260.           if FPicDlg.DecreaseColors then
  261.             SetBitmapPixelFormat(Bmp, pf4bit, DefaultMappingMethod);
  262.           FPicture.Assign(Bmp);
  263.         finally
  264.           Bmp.Free;
  265.         end;
  266.       end
  267.       else FPicture.Assign(FPicDlg.Pic);
  268.     end
  269.     else FPicture.Graphic := nil;
  270.   end;
  271. end;
  272.  
  273. procedure TPictEditor.SetGraphicClass(Value: TGraphicClass);
  274. begin
  275.   FGraphicClass := Value;
  276.   if FPicDlg <> nil then FPicDlg.GraphicClass := Value;
  277. end;
  278.  
  279. procedure TPictEditor.SetPicture(Value: TPicture);
  280. begin
  281.   FPicture.Assign(Value);
  282. end;
  283.  
  284. { Utility routines }
  285.  
  286. function EditGraphic(Graphic: TGraphic; AClass: TGraphicClass;
  287.   const DialogCaption: string): Boolean;
  288. var
  289.   PictureEditor: TPictEditor;
  290. begin
  291.   Result := False;
  292.   if Graphic = nil then Exit;
  293.   PictureEditor := TPictEditor.Create(nil);
  294.   try
  295.     PictureEditor.FPicDlg.Caption := DialogCaption;
  296.     PictureEditor.GraphicClass := AClass;
  297.     if AClass = nil then
  298.       PictureEditor.GraphicClass := TGraphicClass(Graphic.ClassType);
  299.     PictureEditor.Picture.Assign(Graphic);
  300.     Result := PictureEditor.Execute;
  301.     if Result then
  302.       if (PictureEditor.Picture.Graphic = nil) or
  303.          (PictureEditor.Picture.Graphic is PictureEditor.GraphicClass) then
  304.         Graphic.Assign(PictureEditor.Picture.Graphic)
  305.       else Result := False;
  306.   finally
  307.     PictureEditor.Free;
  308.   end;
  309. end;
  310.  
  311. { TPictProperty }
  312.  
  313. procedure TPictProperty.Edit;
  314. var
  315.   PictureEditor: TPictEditor;
  316.   Comp: TPersistent;
  317. begin
  318.   PictureEditor := TPictEditor.Create(nil);
  319.   try
  320.     Comp := GetComponent(0);
  321.     if Comp is TComponent then
  322.       PictureEditor.FPicDlg.Caption := TComponent(Comp).Name + '.' + GetName;
  323.     PictureEditor.Picture := TPicture(Pointer(GetOrdValue));
  324.     if PictureEditor.Execute then
  325.       SetOrdValue(Longint(PictureEditor.Picture));
  326.   finally
  327.     PictureEditor.Free;
  328.   end;
  329. end;
  330.  
  331. function TPictProperty.GetAttributes: TPropertyAttributes;
  332. begin
  333.   Result := [paDialog];
  334. end;
  335.  
  336. function TPictProperty.GetValue: string;
  337. var
  338.   Picture: TPicture;
  339. begin
  340.   Picture := TPicture(GetOrdValue);
  341.   if Picture.Graphic = nil then Result := ResStr(srNone)
  342.   else Result := '(' + Picture.Graphic.ClassName + ')';
  343. end;
  344.  
  345. procedure TPictProperty.SetValue(const Value: string);
  346. begin
  347.   if Value = '' then SetOrdValue(0);
  348. end;
  349.  
  350. { TGraphicPropertyEditor }
  351.  
  352. procedure TGraphicPropertyEditor.Edit;
  353. var
  354.   PictureEditor: TPictEditor;
  355.   Comp: TPersistent;
  356. begin
  357.   PictureEditor := TPictEditor.Create(nil);
  358.   try
  359.     Comp := GetComponent(0);
  360.     if Comp is TComponent then
  361.       PictureEditor.FPicDlg.Caption := TComponent(Comp).Name + '.' + GetName
  362.     else PictureEditor.FPicDlg.Caption := GetName;
  363.     PictureEditor.GraphicClass := TGraphicClass(GetTypeData(GetPropType)^.ClassType);
  364.     PictureEditor.Picture.Graphic := TGraphic(Pointer(GetOrdValue));
  365.     if PictureEditor.Execute then
  366.       if (PictureEditor.Picture.Graphic = nil) or
  367.          (PictureEditor.Picture.Graphic is PictureEditor.GraphicClass) then
  368.         SetOrdValue(LongInt(PictureEditor.Picture.Graphic))
  369.       else raise Exception.Create(ResStr(SInvalidPropertyValue));
  370.   finally
  371.     PictureEditor.Free;
  372.   end;
  373. end;
  374.  
  375. function TGraphicPropertyEditor.GetAttributes: TPropertyAttributes;
  376. begin
  377.   Result := [paDialog];
  378. end;
  379.  
  380. function TGraphicPropertyEditor.GetValue: string;
  381. var
  382.   Graphic: TGraphic;
  383. begin
  384.   Graphic := TGraphic(GetOrdValue);
  385.   if (Graphic = nil) or Graphic.Empty then Result := ResStr(srNone)
  386.   else Result := '(' + Graphic.ClassName + ')';
  387. end;
  388.  
  389. procedure TGraphicPropertyEditor.SetValue(const Value: string);
  390. begin
  391.   if Value = '' then SetOrdValue(0);
  392. end;
  393.  
  394. { TGraphicsEditor }
  395.  
  396. procedure TGraphicsEditor.EditProperty(const Prop: IProperty; var Continue: Boolean);
  397. var
  398.   PropName: string;
  399. begin
  400.   PropName := Prop.GetName;
  401.   if (CompareText(PropName, 'PICTURE') = 0) or
  402.     (CompareText(PropName, 'IMAGE') = 0) or
  403.     (CompareText(PropName, 'GLYPH') = 0) then
  404.   begin
  405.     Prop.Edit;
  406.     Continue := False;
  407.   end;
  408. end;
  409.  
  410. { TPictureEditDialog }
  411.  
  412. procedure TPictureEditDialog.SetGraphicClass(Value: TGraphicClass);
  413. begin
  414.   FGraphicClass := Value;
  415.   CheckEnablePaste;
  416.   DecreaseBox.Enabled := (GraphicClass = TBitmap) or (GraphicClass = TGraphic);
  417. end;
  418.  
  419. procedure TPictureEditDialog.CheckEnablePaste;
  420. begin
  421.   Paste.Enabled := EnablePaste(GraphicClass);
  422. end;
  423.  
  424. procedure TPictureEditDialog.ValidateImage;
  425. var
  426.   Enable: Boolean;
  427. begin
  428.   Enable := ValidPicture(Pic);
  429.   Save.Enabled := Enable;
  430.   Clear.Enabled := Enable;
  431.   Copy.Enabled := Enable;
  432. end;
  433.  
  434. {$IFDEF RX_D3}
  435. procedure TPictureEditDialog.GraphicProgress(Sender: TObject; Stage: TProgressStage;
  436.   PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
  437. begin
  438.   if Stage in [psStarting, psEnding] then begin
  439.     FProgressPos := 0;
  440.     FProgress.Position := 0;
  441.   end
  442.   else if Stage = psRunning then begin
  443.     if PercentDone >= FProgressPos + 10 then begin
  444.       FProgress.Position := PercentDone;
  445.       FProgressPos := PercentDone;
  446.     end;
  447.   end;
  448.   if RedrawNow then ImagePaintBox.Update;
  449. end;
  450. {$ENDIF}
  451.  
  452. procedure TPictureEditDialog.UpdateClipboard(Sender: TObject);
  453. begin
  454.   CheckEnablePaste;
  455. end;
  456.  
  457. procedure TPictureEditDialog.FormCreate(Sender: TObject);
  458. begin
  459.   Pic := TPicture.Create;
  460. {$IFDEF RX_D3}
  461.   FileDialog := TOpenPictureDialog.Create(Self);
  462.   SaveDialog := TSavePictureDialog.Create(Self);
  463.   UsePreviewBox.Visible := False;
  464.   FProgress := TProgressBar.Create(Self);
  465.   with FProgress do begin
  466.     SetBounds(UsePreviewBox.Left, UsePreviewBox.Top, UsePreviewBox.Width,
  467.       UsePreviewBox.Height);
  468.     Parent := Self;
  469.     Min := 0; Max := 100;
  470.     Position := 0;
  471.   end;
  472.   Pic.OnProgress := GraphicProgress;
  473. {$ELSE}
  474.   FileDialog := TOpenDialog.Create(Self);
  475.   SaveDialog := TSaveDialog.Create(Self);
  476. {$ENDIF}
  477.   FileDialog.Title := 'Load picture';
  478.   SaveDialog.Title := 'Save picture as';
  479. {$IFDEF WIN32}
  480.   Bevel.Visible := False;
  481.   Font.Style := [];
  482.   with FormStorage do begin
  483.     UseRegistry := True;
  484.     IniFileName := SDelphiKey;
  485.   end;
  486. {$ELSE}
  487.   if NewStyleControls then Font.Style := [];
  488. {$ENDIF}
  489.   PathsMRU.RecentMenu := PathsMenu.Items;
  490.   FIconColor := clBtnFace;
  491.   HelpContext := hcDPictureEditor;
  492.   Save.Enabled := False;
  493.   Clear.Enabled := False;
  494.   Copy.Enabled := False;
  495.   FClipMonitor := TClipboardMonitor.Create(Self);
  496.   FClipMonitor.OnChange := UpdateClipboard;
  497.   CheckEnablePaste;
  498. end;
  499.  
  500. function TPictureEditDialog.GetDecreaseColors: Boolean;
  501. begin
  502.   Result := DecreaseBox.Checked;
  503. end;
  504.  
  505. procedure TPictureEditDialog.FormDestroy(Sender: TObject);
  506. begin
  507.   FClipMonitor.Free;
  508.   Pic.Free;
  509. end;
  510.  
  511. procedure TPictureEditDialog.LoadFile(const FileName: string);
  512. begin
  513.   Application.ProcessMessages;
  514.   StartWait;
  515.   try
  516.     Pic.LoadFromFile(FileName);
  517.   finally
  518.     StopWait;
  519.   end;
  520.   ImagePaintBox.Invalidate;
  521.   ValidateImage;
  522. end;
  523.  
  524. procedure TPictureEditDialog.LoadClick(Sender: TObject);
  525. {$IFNDEF RX_D3}
  526. var
  527.   FileName: string;
  528. {$ENDIF}
  529. begin
  530. {$IFNDEF RX_D3}
  531.   if UsePreviewBox.Checked then begin
  532.     FileName := '';
  533.     if DirExists(FileDialog.InitialDir) then
  534.       SetCurrentDir(FileDialog.InitialDir);
  535.     if SelectImage(FileName, GraphicExtension(GraphicClass),
  536.       GraphicFilter(GraphicClass)) then
  537.     begin
  538.       FileDialog.Filename := FileName;
  539.       Self.LoadFile(FileName);
  540.     end;
  541.   end
  542.   else begin
  543. {$ENDIF}
  544.     if FileDialog.Execute then begin
  545.       Self.LoadFile(FileDialog.Filename);
  546.     end;
  547. {$IFNDEF RX_D3}
  548.   end;
  549. {$ENDIF}
  550. end;
  551.  
  552. procedure TPictureEditDialog.SaveClick(Sender: TObject);
  553. begin
  554.   if (Pic.Graphic <> nil) and not Pic.Graphic.Empty then begin
  555.     with SaveDialog do begin
  556.       DefaultExt := GraphicExtension(TGraphicClass(Pic.Graphic.ClassType));
  557.       Filter := GraphicFilter(TGraphicClass(Pic.Graphic.ClassType));
  558.       if Execute then begin
  559.         StartWait;
  560.         try
  561.           Pic.SaveToFile(Filename);
  562.         finally
  563.           StopWait;
  564.         end;
  565.       end;
  566.     end;
  567.   end;
  568. end;
  569.  
  570. procedure TPictureEditDialog.DecreaseBMPColors;
  571. begin
  572.   if ValidPicture(Pic) and (Pic.Graphic is TBitmap) and DecreaseColors then
  573.     SetBitmapPixelFormat(Pic.Bitmap, pf4bit, DefaultMappingMethod);
  574. end;
  575.  
  576. procedure TPictureEditDialog.CopyClick(Sender: TObject);
  577. begin
  578.   CopyPicture(Pic, FIconColor);
  579. end;
  580.  
  581. procedure TPictureEditDialog.PasteClick(Sender: TObject);
  582. begin
  583.   if (Pic <> nil) then begin
  584.     PastePicture(Pic, GraphicClass);
  585.     DecreaseBMPColors;
  586.     ImagePaintBox.Invalidate;
  587.     ValidateImage;
  588.   end;
  589. end;
  590.  
  591. procedure TPictureEditDialog.ImagePaintBoxPaint(Sender: TObject);
  592. var
  593.   DrawRect: TRect;
  594.   SNone: string;
  595. {$IFDEF WIN32}
  596.   Ico: HIcon;
  597.   W, H: Integer;
  598. {$ENDIF}
  599. begin
  600.   with TPaintBox(Sender) do begin
  601.     Canvas.Brush.Color := Color;
  602.     DrawRect := ClientRect;
  603.     if ValidPicture(Pic) then begin
  604.       with DrawRect do
  605.         if (Pic.Width > Right - Left) or (Pic.Height > Bottom - Top) then
  606.         begin
  607.           if Pic.Width > Pic.Height then
  608.             Bottom := Top + MulDiv(Pic.Height, Right - Left, Pic.Width)
  609.           else
  610.             Right := Left + MulDiv(Pic.Width, Bottom - Top, Pic.Height);
  611.           Canvas.StretchDraw(DrawRect, Pic.Graphic);
  612.         end
  613.         else begin
  614.           with DrawRect do begin
  615. {$IFDEF WIN32}
  616.             if Pic.Graphic is TIcon then begin
  617.               Ico := CreateRealSizeIcon(Pic.Icon);
  618.               try
  619.                 GetIconSize(Ico, W, H);
  620.                 DrawIconEx(Canvas.Handle, (Left + Right - W) div 2,
  621.                   (Top + Bottom - H) div 2, Ico, W, H, 0, 0, DI_NORMAL);
  622.               finally
  623.                 DestroyIcon(Ico);
  624.               end;
  625.             end else
  626. {$ENDIF}
  627.             Canvas.Draw((Right + Left - Pic.Width) div 2,
  628.               (Bottom + Top - Pic.Height) div 2, Pic.Graphic);
  629.           end;
  630.         end;
  631.     end
  632.     else
  633.       with DrawRect, Canvas do begin
  634.         SNone := ResStr(srNone);
  635.         TextOut(Left + (Right - Left - TextWidth(SNone)) div 2, Top + (Bottom -
  636.           Top - TextHeight(SNone)) div 2, SNone);
  637.       end;
  638.   end;
  639. end;
  640.  
  641. procedure TPictureEditDialog.CreateHandle;
  642. begin
  643.   inherited CreateHandle;
  644.   DragAcceptFiles(Handle, True);
  645. end;
  646.  
  647. procedure TPictureEditDialog.WMDestroy(var Msg: TMessage);
  648. begin
  649.   DragAcceptFiles(Handle, False);
  650.   inherited;
  651. end;
  652.  
  653. procedure TPictureEditDialog.WMDropFiles(var Msg: TWMDropFiles);
  654. var
  655.   AFileName: array[0..255] of Char;
  656.   Num: Cardinal;
  657. begin
  658.   Msg.Result := 0;
  659.   try
  660.     Num := DragQueryFile(Msg.Drop, {$IFDEF WIN32} $FFFFFFFF {$ELSE}
  661.       $FFFF {$ENDIF}, nil, 0);
  662.     if Num > 0 then begin
  663.       DragQueryFile(Msg.Drop, 0, PChar(@AFileName), Pred(SizeOf(AFileName)));
  664.       Application.BringToFront;
  665.       Self.LoadFile(StrPas(AFileName));
  666.     end;
  667.   finally
  668.     DragFinish(Msg.Drop);
  669.   end;
  670. end;
  671.  
  672. procedure TPictureEditDialog.UpdatePathsMenu;
  673. var
  674.   I: Integer;
  675. begin
  676.   for I := 0 to PathsMenu.Items.Count - 1 do begin
  677.     PathsMenu.Items[I].Checked := CompareText(PathsMenu.Items[I].Caption,
  678.       FileDialog.InitialDir) = 0;
  679.   end;
  680. end;
  681.  
  682. procedure TPictureEditDialog.ClearClick(Sender: TObject);
  683. begin
  684.   Pic.Graphic := nil;
  685.   ImagePaintBox.Invalidate;
  686.   Save.Enabled := False;
  687.   Clear.Enabled := False;
  688.   Copy.Enabled := False;
  689. end;
  690.  
  691. procedure TPictureEditDialog.HelpBtnClick(Sender: TObject);
  692. begin
  693.   Application.HelpContext(HelpContext);
  694. end;
  695.  
  696. const
  697.   sBackColorIdent = 'ClipboardBackColor';
  698.   sFileDir = 'FileDialog.InitialDir';
  699.  
  700. procedure TPictureEditDialog.FormStorageRestorePlacement(Sender: TObject);
  701. begin
  702.   FIconColor := TColor(IniReadInteger(FormStorage.IniFileObject,
  703.     FormStorage.IniSection, sBackColorIdent, clBtnFace));
  704.   FileDialog.InitialDir := IniReadString(FormStorage.IniFileObject,
  705.     FormStorage.IniSection, sFileDir, FileDialog.InitialDir);
  706. end;
  707.  
  708. procedure TPictureEditDialog.FormStorageSavePlacement(Sender: TObject);
  709. begin
  710.   IniWriteInteger(FormStorage.IniFileObject, FormStorage.IniSection,
  711.     sBackColorIdent, FIconColor);
  712.   IniWriteString(FormStorage.IniFileObject, FormStorage.IniSection,
  713.     sFileDir, FileDialog.InitialDir);
  714. end;
  715.  
  716. procedure TPictureEditDialog.PathsClick(Sender: TObject);
  717. begin
  718.   if EditFolderList(PathsMRU.Strings) then
  719.     UpdatePathsMenu;
  720. end;
  721.  
  722. procedure TPictureEditDialog.PathsMRUClick(Sender: TObject;
  723.   const RecentName, Caption: string; UserData: Longint);
  724. begin
  725.   if DirExists(RecentName) then begin
  726.     {SetCurrentDir(RecentName);}
  727.     FileDialog.InitialDir := RecentName;
  728.   end
  729.   else begin
  730.     PathsMRU.Remove(RecentName);
  731.   end;
  732.   UpdatePathsMenu;
  733. end;
  734.  
  735. procedure TPictureEditDialog.PathsMenuPopup(Sender: TObject);
  736. begin
  737.   UpdatePathsMenu;
  738. end;
  739.  
  740. procedure TPictureEditDialog.PathsMRUChange(Sender: TObject);
  741. begin
  742.   PathsBtn.Enabled := PathsMRU.Strings.Count > 0;
  743. end;
  744.  
  745. end.
  746.