fcPicEdt.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:4k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit fcPicEdt;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   ExtCtrls, StdCtrls, ExtDlgs, TypInfo, fcCommon, fcBitmap;
  6. type
  7.   TfcGraphicType = (gtBitmap, gtIcon, gtJPEG, gtEmf, gtWmf);
  8. const
  9.   GRAPHICTYPES: array[TfcGraphicType] of string = ('Bitmap', 'Icon', 'JPEG Image', 'Enhanced Metafile', 'Windows Metafile');
  10. type
  11.   TfcPictureEditor = class(TForm)
  12.     OKButton: TButton;
  13.     CancelButton: TButton;
  14.     HelpButton: TButton;
  15.     Panel: TPanel;
  16.     ImagePanel: TPanel;
  17.     LoadButton: TButton;
  18.     SaveButton: TButton;
  19.     ClearButton: TButton;
  20.     Image: TImage;
  21.     OpenDialog: TOpenPictureDialog;
  22.     SaveDialog: TSavePictureDialog;
  23.     procedure LoadButtonClick(Sender: TObject);
  24.     procedure SaveButtonClick(Sender: TObject);
  25.     procedure ClearButtonClick(Sender: TObject);
  26.     procedure HelpButtonClick(Sender: TObject);
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure FormDestroy(Sender: TObject);
  29.   private
  30.     { Private declarations }
  31.     procedure UpdateImage;
  32.   public
  33.     { Public declarations }
  34.     StoredImage: TPicture;
  35.   end;
  36.   function fcExecutePictureEditor(AGraphic: TGraphic;
  37.     DestGraphic: TPersistent): Boolean;
  38. var
  39.   fcPictureEditor: TfcPictureEditor;
  40. implementation
  41. {$R *.DFM}
  42. function fcExecutePictureEditor(AGraphic: TGraphic;
  43.   DestGraphic: TPersistent): Boolean;
  44. begin
  45.   result := False;
  46.   with TfcPictureEditor.Create(Application) do
  47.   begin
  48.     StoredImage.Assign(AGraphic);
  49.     UpdateImage;
  50.     if ShowModal = mrOK then
  51.     begin
  52.       result := True;
  53.       DestGraphic.Assign(StoredImage.Graphic);
  54.     end;
  55.     Free;
  56.   end;
  57. end;
  58. procedure TfcPictureEditor.UpdateImage;
  59. var s: TSize;
  60. begin
  61.   if (StoredImage.Graphic <> nil) and not StoredImage.Graphic.Empty then
  62.   begin
  63.     s := fcSize(StoredImage.Width, StoredImage.Height);
  64.     if (StoredImage.Width > Image.Width) or (StoredImage.Height > Image.Height) then
  65.     begin
  66.       if StoredImage.Width > StoredImage.Height then
  67.         s := fcSize(Image.Width, Image.Width * StoredImage.Height div StoredImage.Width)
  68.       else s := fcSize(Image.Height * StoredImage.Width div StoredImage.Height, Image.Height);
  69.     end;
  70.     Image.Picture.Bitmap.Width := s.cx;
  71.     Image.Picture.Bitmap.Height := s.cy;
  72.     Image.Picture.Bitmap.Canvas.StretchDraw(Rect(0, 0, s.cx, s.cy), StoredImage.Graphic);
  73.     ImagePanel.Caption := '';
  74.   end else begin
  75.     Image.Picture.Bitmap.Assign(nil);
  76.     Image.Repaint;
  77.     ImagePanel.Caption := '(None)';
  78.   end;
  79. end;
  80. procedure TfcPictureEditor.LoadButtonClick(Sender: TObject);
  81. begin
  82.   if OpenDialog.Execute then
  83.   begin
  84.     StoredImage.LoadFromFile(OpenDialog.FileName);
  85.     UpdateImage;
  86.   end;
  87. end;
  88. procedure TfcPictureEditor.SaveButtonClick(Sender: TObject);
  89. begin
  90.   if SaveDialog.Execute then
  91.     StoredImage.SaveToFile(SaveDialog.FileName);
  92. end;
  93. procedure TfcPictureEditor.ClearButtonClick(Sender: TObject);
  94. begin
  95.   StoredImage.Free;
  96.   StoredImage := TPicture.Create;
  97. //  StoredImage.RespectPalette := True;
  98.   UpdateImage;
  99. end;
  100. procedure TfcPictureEditor.HelpButtonClick(Sender: TObject);
  101. var KLinkMacro: PChar;
  102. begin
  103.   KLinkMacro := 'KL("Picture Editor", 1, "", "")';
  104.   WinHelp(Handle, PChar(Application.HelpFile), HELP_COMMAND, Integer(KLinkMacro));
  105. end;
  106. procedure TfcPictureEditor.FormCreate(Sender: TObject);
  107. begin
  108.   StoredImage := TPicture.Create;
  109. //  StoredImage.RespectPalette := True;
  110. end;
  111. procedure TfcPictureEditor.FormDestroy(Sender: TObject);
  112. begin
  113.   StoredImage.Free;
  114. end;
  115. end.