本文整理自网络,侵删。

源代码: https://pan.baidu.com/s/1s921i0M-VFaW-8z7yYeozQ 提取码: jkq3
unit Unit8;
interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
type TForm8 = class(TForm) Button1: TButton; CheckBox1: TCheckBox; ScrollBox1: TScrollBox; Image1: TImage; procedure Button1Click(Sender: TObject); procedure CheckBox1Click(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form8: TForm8;
implementation
{$R *.dfm}
uses Clipbrd,jpeg;
procedure TForm8.Button1Click(Sender: TObject);var i:integer; FIsBitmap:boolean;
begin
FIsBitmap:=false; for i:=0 to clipboard.FormatCount -1 do //检测ClipBoard中是否有位图 if Clipboard.Formats[i]=2 then begin FIsBitmap:=true; break; end; if FIsBitmap then begin if checkbox1.Checked then begin image1.AutoSize:= false; image1.Width:= scrollbox1.ClientWidth-4; end else image1.AutoSize:= true; Image1.Picture.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0); if checkbox1.Checked then image1.Height:= round(image1.Picture.Bitmap.Height * (image1.Width / image1.Picture.Bitmap.Width)); //自动设定高度
Image1.Top:= 2; Image1.Left:= 2; end else begin
Showmessage('剪贴板中没有图片!'); end;
end;
procedure TForm8.CheckBox1Click(Sender: TObject);var k: integer;begin Image1.Top:= 2; Image1.Left:= 2; if checkbox1.Checked then begin image1.AutoSize:= false; image1.Stretch:= false; image1.Width:= scrollbox1.ClientWidth-4; k:= image1.Picture.Bitmap.Width; if k=0 then k:= image1.Picture.Graphic.Width; image1.Height:= round(image1.Height * (image1.Width / k)); //自动设定高度 image1.Stretch:= true; end else image1.AutoSize:= true;
end;
end.
相关阅读 >>
Delphi2010的操作界面切换到Delphi7的操作模式
Delphi 文字的高度与宽度: canvas.textextent
更多相关阅读请进入《Delphi》频道 >>