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

📄 frmresres.pas

📁 Apprehend Screen Capture Component Version 4.2 A non-visible component to capture images. Freeware w
💻 PAS
字号:
{******************************************************************************}
{*                                                                            *}
{*                  Adirondack Software & Graphics                            *}
{*                             ResRes Unit                                    *}
{*          (C) Copyright Adirondack Software & Graphics 1996-2001            *}
{*                                                                            *}
{******************************************************************************}

unit frmresres;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ComCtrls, StdCtrls, ImageEnView, ImageEn, ImageEnIO, ImageEnProc, HYIEDefs,
   GX_GradientBar, ExtCtrls;

type
   TfResize = class(TForm)
      Button1: TButton;
      Button2: TButton;
      GroupBox2: TGroupBox;
      CheckBox1: TCheckBox;
      Label3: TLabel;
      ComboBox1: TComboBox;
      GroupBox3: TGroupBox;
      Label1: TLabel;
      Label2: TLabel;
      ImageEnProc1: TImageEnProc;
      ImageEnIO1: TImageEnIO;
      Edit1: TEdit;
      Edit2: TEdit;
      UpDown1: TUpDown;
      UpDown2: TUpDown;
      CheckBox2: TCheckBox;
      ResetBtn: TButton;
      ImageEnView1: TImageEnView;
      Panel1: TPanel;
    PeviewButton: TButton;
      procedure FormActivate(Sender: TObject);
      procedure Edit1Change(Sender: TObject);
      procedure Edit2Change(Sender: TObject);
      procedure ResetBtnClick(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure ImageEnView1MouseDown(Sender: TObject; Button: TMouseButton;
         Shift: TShiftState; X, Y: Integer);
      procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
      procedure UpDown2Changing(Sender: TObject; var AllowChange: Boolean);
    procedure PeviewButtonClick(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
   private
    { Private declarations }
      DontChange: boolean;
      procedure Preview;
   public
    { Public declarations }
      OrgWidth, OrgHeight: integer;
      Resize: Boolean;
      Resample: Boolean;
   end;

var
   fResize: TfResize;

implementation

uses frmMain;

{$R *.DFM}

procedure TfResize.FormCreate(Sender: TObject);
begin
   ImageEnView1.MouseInteract := [miZoom, miScroll];
   ImageEnView1.Cursor := 1779;
   ImageEnView1.Scrollbars := ssBoth;
   ImageEnView1.ZoomFilter := rfNone;
   ImageEnView1.BackgroundStyle := iebsChessboard;
   ImageEnView1.BackGround := clWhite;
   ImageEnIO1.AttachedImageEn := ImageEnView1;
   ImageEnProc1.AttachedImageEn := ImageEnView1;
end;

procedure TfResize.FormActivate(Sender: TObject);
begin
   Edit1.Text := IntToStr(OrgWidth);
   Edit2.Text := IntToStr(OrgHeight);
   DontChange := False;
   ComboBox1.ItemIndex := 0;
   Edit1.SetFocus;
end;

procedure TfResize.Edit1Change(Sender: TObject);
begin
   if CheckBox1.Checked and not DontChange then begin
      DontChange := True;
      Edit2.Text := IntToStr(Round(OrgHeight * StrToIntDef(Edit1.Text, 0) / OrgWidth));
      DontChange := False;
   end;
end;

procedure TfResize.Edit2Change(Sender: TObject);
begin
   if CheckBox1.Checked and not DontChange then
   begin
      DontChange := True;
      Edit1.Text := IntToStr(Round(OrgWidth * StrToIntDef(Edit2.Text, 0) / OrgHeight));
      DontChange := False;
   end;
end;

procedure TfResize.Preview;
var
   w, h: integer;
begin
   if CheckBox1.checked and not DontChange then begin
      DontChange := true;
      w := StrToIntDef(fResize.Edit1.Text, 0);
      h := StrToIntDef(fResize.Edit2.Text, 0);
      if (w > 0) and (h > 0) then begin
         if Resize then
            ImageEnProc1.ImageResize(w, h);
         if Resample then
            ImageEnProc1.Resample(w, h, TResampleFilter(fResize.ComboBox1.ItemIndex));
         ImageEnView1.Update;
      end;
      DontChange := False;
   end
   else
   begin
      DontChange := true;
      w := StrToIntDef(fResize.Edit1.Text, 0);
      h := StrToIntDef(fResize.Edit2.Text, 0);
      if (w > 0) and (h > 0) then begin
         if Resize then
            ImageEnProc1.ImageResize(w, h);
         if Resample then
            ImageEnProc1.Resample(w, h, TResampleFilter(fResize.ComboBox1.ItemIndex));
         ImageEnView1.Update;
      end;
      DontChange := False;
   end;
end;

procedure TfResize.ResetBtnClick(Sender: TObject);
begin
   fResize.ImageEnView1.Assign(TImageENView(FormMain.PageControl1.ActivePage.Controls[0]).Bitmap);
   Edit1.Text := IntToStr(OrgWidth);
   Edit2.Text := IntToStr(OrgHeight);
   DontChange := False;
   ComboBox1.ItemIndex := 0;
   OrgWidth := ImageENView1.Bitmap.Width;
   OrgHeight := ImageENView1.Bitmap.Height;
   Edit1.Text := IntToStr(OrgWidth);
   Edit2.Text := IntToStr(OrgHeight);
   Edit1.SetFocus;
end;

procedure TfResize.FormShow(Sender: TObject);
begin
  // save undo file
   ImageEnProc1.SaveUndo;
end;

procedure TfResize.ImageEnView1MouseDown(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if ImageEnView1.MouseInteract = [miZoom, miScroll] then
      ImageEnView1.Cursor := 1779 else
      ImageEnView1.Cursor := 1782;
end;

procedure TfResize.UpDown1Changing(Sender: TObject;
   var AllowChange: Boolean);
begin
   if CheckBox2.Checked then
      Preview;
end;

procedure TfResize.UpDown2Changing(Sender: TObject;
   var AllowChange: Boolean);
begin
   if CheckBox2.Checked then
      Preview;
end;

procedure TfResize.PeviewButtonClick(Sender: TObject);
begin
  Preview;
end;

procedure TfResize.CheckBox2Click(Sender: TObject);
begin
  PeviewButton.Enabled := not CheckBox2.Checked
end;

end.

⌨️ 快捷键说明

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