bmpview.pas

Delphi高级程序开发配书源代码,可以循序渐进的学习Delphi.

unit BmpView;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, Menus;

type
  TBmpViewer = class(TForm)
    MainMenu1: TMainMenu;
    TabControl1: TTabControl;
    Image1: TImage;
    mFile: TMenuItem;
    mOpen: TMenuItem;
    N1: TMenuItem;
    mExit: TMenuItem;
    mEdit: TMenuItem;
    mCut: TMenuItem;
    mCopy: TMenuItem;
    mPaste: TMenuItem;
    N2: TMenuItem;
    mDel: TMenuItem;
    mHelp: TMenuItem;
    mAbout: TMenuItem;
    OpenDialog1: TOpenDialog;
    procedure mOpenClick(Sender: TObject);
    procedure TabControl1Change(Sender: TObject);
    procedure TabControl1DrawTab(Control: TCustomTabControl;
      TabIndex: Integer; const Rect: TRect; Active: Boolean);
    procedure mExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mCutClick(Sender: TObject);
    procedure mCopyClick(Sender: TObject);
    procedure mPasteClick(Sender: TObject);
    procedure mDelClick(Sender: TObject);
    procedure mEditClick(Sender: TObject);
    procedure mAboutClick(Sender: TObject);
  private
     TabBmp: TBitmap;
  public
    { Public declarations }
  end;

var
  BmpViewer: TBmpViewer;

implementation

{$R *.dfm}
uses
  Clipbrd;   //因为要用到剪贴板

const
  BmpSide = 20;
procedure TBmpViewer.mOpenClick(Sender: TObject);
begin
if OpenDialog1.Execute then
  begin            //调用打开文件对话框组件
    TabControl1.Tabs.AddStrings (OpenDialog1.Files);
                   //显示相应bmp文件名
    TabControl1.TabIndex := 0;
    TabControl1Change (TabControl1);  //使设置生效
  end;
end;

procedure TBmpViewer.TabControl1Change(Sender: TObject);
var
  TabText: string;
begin
  Image1.Visible := True;        //使图片可见
  TabText := TabControl1.Tabs [TabControl1.TabIndex];
  if TabText <> 'Clipboard' then
    //装入在tab中要显示的文件
    Image1.Picture.LoadFromFile (TabText)
  else
    //如果tab目前对应clipboard并且在简帖版中的位图可用
    if Clipboard.HasFormat (cf_Bitmap) then
      Image1.Picture.Assign (Clipboard)
    else
    begin
      TabControl1.Tabs.Delete (TabControl1.TabIndex);
      if TabControl1.Tabs.Count = 0 then
        Image1.Visible := False;//使图片不可见
    end;
end;

procedure TBmpViewer.TabControl1DrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
 TabText: string;
 OutRect: TRect;     //对应tab名称的输出区域
begin
  TabText := TabControl1.Tabs [TabIndex];
  OutRect := Rect;
  InflateRect (OutRect, -3, -3);
  OutRect.Left := OutRect.Left + BmpSide + 3;
  DrawText (Control.Canvas.Handle,
    PChar (ExtractFileName (TabText)),
    Length (ExtractFileName (TabText)),//画出tabtext
    OutRect, dt_Left or dt_SingleLine or dt_VCenter);
  if TabText = 'Clipboard' then
    if Clipboard.HasFormat (cf_Bitmap) then
      TabBmp.Assign (Clipboard) //剪贴板的内容载入
    else
      TabBmp.FreeImage
  else
    TabBmp.LoadFromFile (TabText); //装入以tabtext为文件名的位图
  OutRect.Left := OutRect.Left - BmpSide - 3;
  OutRect.Right := OutRect.Left + BmpSide;
  Control.Canvas.StretchDraw (OutRect, TabBmp);
   //显示位图
end;
procedure TBmpViewer.mExitClick(Sender: TObject);
begin
  close; //退出程序
end;

procedure TBmpViewer.FormCreate(Sender: TObject);
begin
 TabControl1.TabHeight := BmpSide + 6;
 //设置tabcontrol高度
  TabBmp := TBitmap.Create; //创建位图对象
end;

procedure TBmpViewer.FormDestroy(Sender: TObject);
begin
 TabBmp.Free;       //释放位图对象
end;

procedure TBmpViewer.mCutClick(Sender: TObject);
begin
  mCopyClick (Self);   //通过拷贝和删除实现剪切
  mDelClick (Self);
end;

procedure TBmpViewer.mCopyClick(Sender: TObject);
begin
Clipboard.Assign (Image1.Picture.Graphic);
 //将image1中的图片装入剪贴板
end;

procedure TBmpViewer.mPasteClick(Sender: TObject);
var
  TabNum: Integer;
begin
  // 装入tab对应的页
  TabNum := TabControl1.Tabs.IndexOf ('Clipboard');
  if TabNum < 0 then
    // 如果不存在则为clipboard创建一个新页
    TabNum := TabControl1.Tabs.Add ('Clipboard');
  // 将焦点设到该页并使之重绘
  TabControl1.TabIndex := TabNum;
  TabControl1Change (Self);
end;

procedure TBmpViewer.mDelClick(Sender: TObject);
begin
  with TabControl1 do
  begin
    if TabIndex >= 0 then
      //如果存在图片，则删除它
      Tabs.Delete (TabIndex);
    if Tabs.Count = 0 then
      Image1.Visible := False
    else   //如果所有的tab夜都被删除，则使image1不可见
      TabControl1Change (Self);
  end;
end;

procedure TBmpViewer.mEditClick(Sender: TObject);
begin
  mPaste.Enabled := Clipboard.HasFormat (cf_Bitmap);
  if TabControl1.Tabs.Count > 0 then
  begin   //当进入编辑菜单使根据情况设置对应的子菜单项是否可见
    mCut.Enabled := True;
    mCopy.Enabled := True;
    mDel.Enabled := True;
  end
  else
  begin
    mCut.Enabled := False;
    mCopy.Enabled := False;
    mDel.Enabled := False;
  end;
end;

procedure TBmpViewer.mAboutClick(Sender: TObject);
begin
MessageDlg ('Bitmap 文件浏览 with Tabs, from "Delphi 7高级编程"',
    mtInformation, [mbOk], 0);
    //显示提示信息
end;

end.