unit1.pas

简单的DELPHI的绘图程序,可以画出不同的各种已知图形,书上看的.与大家分享

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, FileCtrl, StdCtrls,jpeg;

type
  TForm1 = class(TForm)
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    ScrollBox1: TScrollBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

//私有类声明
type
  tbi_thumb=class(TCustomcontrol)
  fmypic : TJpegImage;
  private
   procedure getpic(value:tjpegimage);
  public
   procedure paint; override;
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
  published
   property pic:tjpegimage write getpic;
end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  buffer_jpeg:tjpegimage;

constructor tbi_thumb.create(aowner:tcomponent);
begin
  inherited;
  fmypic:=tjpegimage.create;
end;

destructor tbi_thumb.destroy;
begin
  inherited;
  fmypic.free;
end;

procedure tbi_thumb.getpic(value:tjpegimage);
begin
  fmypic.scale:=jshalf;
  fmypic.assign(value);
  fmypic.dibneeded;
end;

procedure tbi_thumb.paint;
var
  arect : trect;
  ratio : single;
begin
  arect:=clientrect;
  canvas.stretchdraw(arect,fmypic);
  frame3d(canvas,arect,clblack,clwhite,2);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  buffer_jpeg:=tjpegimage.create;
  buffer_jpeg.Performance:=jpbestspeed;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  buffer_jpeg.free;
  while scrollbox1.ComponentCount>0 do
     scrollbox1.components[0].free;
end;

procedure TForm1.DirectoryListBox1Change(Sender: TObject);
var
  i,x,y     : integer;
  anewthumb : tbi_thumb;
  foundlist : tstringlist;
  sr        : TSearchRec;
begin
  foundlist:=tstringlist.create;
  //查找图象文件
  try
    if FindFirst(directorylistbox1.Directory+'\*.jpg', faAnyFile, sr) = 0 then
      begin
        foundlist.add(sr.name);
        while FindNext(sr) = 0 do
             foundlist.add(sr.name);
        FindClose(sr);
      end;
  x:=0;
  y:=0;
//创建缩略图
  for i:=0 to FoundList.count-1 do
    begin
      anewthumb:=tbi_thumb.create(self);
      buffer_jpeg.loadfromfile(foundlist[i]);
      with anewthumb do
        begin
          pic:=buffer_jpeg;
          parent:=scrollbox1;
          left:=x;
          top:=y;
          width:=120;
          height:=90;
          visible:=true;
          inc(x,122);
          if x>244 then
            begin
              x:=0;
              inc(y,92);
            end;
          application.processmessages;
       end;
    end;
  finally
    foundlist.free;
  end;
end;

end.