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

📄 unit1.pas

📁 本光盘是《Delphi 7应用教程》一书的配套光盘
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    RadioButton2: TRadioButton;
    RadioButton1: TRadioButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
//    procedure FormShow(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
 Var
  FName:String;//背景填充的图片文件名
{$R *.dfm}
Procedure  btile() ;  //平铺填充
var
    Bitmap:TBitmap;
  begin
      Bitmap:=TBitmap.Create ;//创建位图对象
      Bitmap.LoadFromFile(FName );  //装载图像
      Form1.Canvas.Brush.Bitmap :=Bitmap; //把位图对象赋值给Brush.bitmap,以便填充
      Form1.Canvas.rectangle(0,0,Form1.width,Form1.height);
      //在整个窗体内画矩形,用位图填充,平铺效果
      Bitmap:=nil;  //卸载位图
  end;
Procedure bStretch();   //拉伸填充
  var
    Picture:TPicture;
  begin
     Picture:=TPicture.Create ;  //创建Picture位图
     Picture.LoadFromFile(FName );//装载图像
     Form1.Canvas.Stretchdraw(Rect(0,0,Form1.width,Form1.height),Picture.Graphic );
     //使用StretchDraw方法在整个窗体上绘图,拉伸效果
     Picture:=nil;  //卸载Picture对象
  end;

procedure TForm1.Button1Click(Sender: TObject);//选择一个图片文件以填充
 begin
   If OpenDialog1.Execute then   // 弹出“打开”对话框以选择文件
      begin
          Fname:=OpenDialog1.FileName ;
          if RadioButton1.Checked then  //如果选择了平铺单选钮
              btile     //平铺填充
           else
              bStretch;  //拉伸填充
      end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
  CurDir:String;
begin
  GetDir(0,CurDir);   //获取当前路径
  FName:=CurDir+'\Default.BMP';  //设置缺省填充的图片名
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
   BTile;  //平铺填充
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  Bstretch; //拉伸填充
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
 if RadioButton1.Checked  then
        bTile
  else
        bstretch;
end;

end.

⌨️ 快捷键说明

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