⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 createimage.pas

📁 类似Delphi Ide的对象查看器 可以在RUNTIME时使用
💻 PAS
字号:
unit CreateImage;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtDlgs, ExtCtrls, MyPanel, StdCtrls, MyButton, MyAutoBtn, PropEdit, Jpeg;

type
  Tfrm_Editimage = class(TForm)
    pnlImage: TMyPanel;
    pntImage: TPaintBox;
    opdImage: TOpenPictureDialog;
    svdImage: TSavePictureDialog;
    btnOk: TMyAutoBitBtn;
    btnCancel: TMyAutoBitBtn;
    btnLoad: TMyAutoBitBtn;
    btnSave: TMyAutoBitBtn;
    btnClear: TMyAutoBitBtn;
    procedure btnLoadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
  private
    FPicture: TPicture;
    { Private declarations }
  public
    property Picture: TPicture read FPicture;
    { Public declarations }
  end;

  TPicturePropertyEditor = class(TPropertyEditor)
    function Execute: Boolean; override;
  end;
  
{var
  frm_Editimage: Tfrm_Editimage;}

implementation

{$R *.dfm}

function TPicturePropertyEditor.Execute: Boolean;
begin
  with Tfrm_Editimage.Create(nil) do
  try
    with Prop do
      if PropType=TypeInfo(TPicture) then FPicture.Assign(TPicture(Prop.AsObject))
      else
        if PropType=TypeInfo(TBitmap) then
        begin
          FPicture.Bitmap:=TBitmap(Prop.AsObject);
          opdImage.Filter:='Bitmaps (*.bmp)|*.bmp';
          svdImage.Filter:=opdImage.Filter;
        end
        else
          if PropType=TypeInfo(TIcon) then
          begin
            FPicture.Icon:=TIcon(Prop.AsObject);
            opdImage.Filter:='Icon files (*.ico)|*.ico';
            svdImage.Filter:=opdImage.Filter;
          end
          else FPicture.Graphic:=TGraphic(Prop.AsObject);
    Result:=ShowModal=mrOk;
    if Result then
      with Prop do
        if PropType=TypeInfo(TPicture) then TPicture(Prop.AsObject).Assign(FPicture)
        else
          Prop.AsObject:=FPicture.Graphic;
  finally
    Free;
  end;
end;

procedure Tfrm_Editimage.btnLoadClick(Sender: TObject);
begin
  with opdImage do
    if Execute then
    begin
      FPicture.LoadFromFile(FileName);
      pntImage.Repaint;
    end;
end;

procedure Tfrm_Editimage.btnSaveClick(Sender: TObject);
begin
  with FPicture,svdImage do
    if not Graphic.Empty and Execute then SaveToFile(FileName);
end;

procedure Tfrm_Editimage.btnClearClick(Sender: TObject);
begin
  FPicture.Graphic:=nil;
  pntImage.Repaint;
end;

procedure Tfrm_Editimage.FormCreate(Sender: TObject);
begin
  FPicture:=TPicture.Create;
  if GetACP=936 then
    self.Caption:='图像编辑器'
  else if GetACP=950 then
    self.Caption:='瓜钩絪胯竟'
  else self.Caption:='Image Editor';
end;

procedure Tfrm_Editimage.FormDeactivate(Sender: TObject);
begin
  FPicture.Free;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -