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

📄 unit1.pas

📁 (Delphi) Universal dib codes. Usign DIB palettes, dib bitmaps and more
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UniDIB,DIBTools, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button: TButton;
    OpenDialog: TOpenDialog;
    CheckBox: TCheckBox;
    Label1: TLabel;
    procedure FormPaint(Sender: TObject);
    procedure ButtonClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Pic:TPicture;
    DIB:TUniDIB;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormPaint(Sender: TObject);
begin
  If DIB<>nil then
    DIB.DIBToScreen (Canvas.Handle)
  else
    If Pic<>nil then
      Canvas.Draw (0,0,Pic.Graphic);
end;

procedure TForm1.ButtonClick(Sender: TObject);
var A,X:Integer;
    S:String;
begin
  If OpenDialog.FileName<>'' then
    OpenDialog.InitialDir:=ExtractFilePath (OpenDialog.FileName);
  If OpenDialog.Execute then
  begin
    S:=AnsiUpperCase(ExtractFileExt (OpenDialog.FileName));
    If (S<>'.BMP') then
      If (S<>'.PCX') OR ((S='.PCX') AND NOT CheckBox.Checked) then
      begin
        MessageDlg ('Bad file extension !',mtError,[mbOK],0); 
        Exit;
      end;
    DIB.Free;
    DIB:=nil;
    Pic.Free;
    Pic:=nil;
    X:=GetTickCount;
    If CheckBox.Checked then
    begin
      If S='.PCX' then
        A:=UDIBLoadPCX (OpenDialog.FileName,DIB)
      else
        A:=UDIBLoadBMP (OpenDialog.FileName,DIB);
      If A<>UDIBNoError then
      begin
        Repaint;
        MessageDlg ('Error when loading file !',mtError,[mbOK],0);
        Exit;
      end;
    end
    else
    begin
      Pic:=TPicture.Create;
      Pic.LoadFromFile (OpenDialog.FileName);
    end;
    X:=GetTickCount-X;
    Repaint;
    MessageDlg ('Time : '+IntToStr(X)+' ms',mtInformation,[mbOK],0);
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Button.SetBounds (ClientWidth-Button.Width-10,10,Button.Width,Button.Height);
  CheckBox.SetBounds (ClientWidth-CheckBox.Width-4,45,CheckBox.Width,CheckBox.Height);
  Label1.SetBounds (8,ClientHeight-20,Label1.Width,Label1.Height);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DIB:=nil;
  Pic:=nil;
  OpenDialog.InitialDir:=ExtractFilePath(Application.ExeName);
end;

end.

⌨️ 快捷键说明

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