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

📄 unit1.pas

📁 delphi 资源文件 的使用,包括位图,exe文件,声音文件等
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;
const
 BntOK=5010;
 BntClose=5011;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Image1: TImage;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Memo1: TMemo;
    Button9: TButton;
    Bevel1: TBevel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
  private
    Wnd:THandle;
    procedure DlgProc(var Msg:TMessage);
  end;

var
  Form1: TForm1;

implementation
uses MMSystem;
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
Var
 HRes:HRSRC;
 HGlobalRes:HGLOBAL;
 pMemRes:Pointer;
 MM:TMemoryStream;
 ResLeng:DWord;
begin
 MM:=TMemoryStream.Create;
 HRes:=FindResource(HInstance,MAKEINTRESOURCE(1001),'MYTYPE');
 HGlobalRes:=LoadResource(HInstance,HRes);
 pMemRes:=LockResource(HGlobalRes);
 ResLeng:=SizeofResource(0,hRes);
 if ResLeng>0 then
  begin
   MM.Write(pMemRes^,ResLeng);
   MM.SaveToFile('A.exe');
  end;
 FreeAndNil(MM);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 hRes:HRSRC;
 HGlobalRes:HGLOBAL;
 PtrSound:Pointer;
begin
 hRes:=FindResource(HInstance,'SOUNDX','WAVE');
 HGlobalRes:=LoadResource(HInstance, hRes);
 if HGlobalRes > 32 then
  begin
   ptrSound:=LockResource(HGlobalRes);
   sndplaysound(ptrSound,snd_async or snd_Memory);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
 pMemRes:Pointer;
 MM:TMemoryStream;
begin
 pMemRes:=LockResource(LoadResource(HInstance,FindResource(HInstance,
                                   MAKEINTRESOURCE(1001),'MYTYPE')));
 if pMemRes<>nil then
  begin
   MM:=TMemoryStream.Create;
   MM.Write(pMemRes^,SizeOfResource(0,FindResource(HInstance,
                                   MAKEINTRESOURCE(1001),'MYTYPE')));
   MM.SaveToFile('B.exe');
   FreeAndNil(MM);
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 Image1.Picture.Bitmap.LoadFromResourceName(HInstance,'BitmapX');
end;

procedure TForm1.Button5Click(Sender: TObject);
var
 rs:TResourceStream;
begin
 rs:=TResourceStream.Create(hInstance,'SOUNDX','WAVE');
 sndplaysound(rs.Memory,snd_async or snd_Memory);
 FreeAndNil(rs);
end;

procedure TForm1.Button6Click(Sender: TObject);
var
 rs:TResourceStream;
begin
 rs:=TResourceStream.Create(hInstance,'ExeFileX',RT_RCData);
 rs.SaveToFile('C.exe');
 FreeAndNil(rs);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  Wnd:=CreateDialog(HInstance,'DLG',0,MakeObjectInstance(DlgProc));
end;

procedure TForm1.DlgProc(var Msg:TMessage);
begin
  case Msg.Msg of
    WM_Close:begin DestroyWindow(Wnd);Msg.Result:=1; end;
  end;
  case Msg.WParam of
    BntClose:SendMessage(Wnd,WM_Close,0,0);
    BntOK:MessageBox(Wnd,'要关闭对话框请按关闭按钮','信息',64);
  end;

 Msg.Result:=0;
end;

procedure TForm1.Button8Click(Sender: TObject);
var
 i:integer;
begin
 Memo1.lines.Add('=== 中文 ===');
 for i:=1000 to 1002 do
   Memo1.Lines.Add(LoadStr(i));
 Memo1.lines.Add('=== 英文 ===');
 for i:=2000 to 2002 do
   Memo1.Lines.Add(LoadStr(i));
end;

procedure TForm1.Button9Click(Sender: TObject);
const
 ct=#10#13;
var
 name:string;
 size,z:Dword;
 buff:array of byte;
 p:Pointer;
 Ms:TMemoryStream;
 sl:TStringList;
begin
  Ms:=TMemoryStream.Create;
  sl:=TStringList.Create;
  name:=ExtractFileName(Application.ExeName);
  size:=GetFileVersionInfoSize(Pchar(name),z);
  GetMem(buff,size);
  GetFileVersionInfo(PChar(name),z,size,buff);

  VerQueryValue(buff,'\StringFileInfo\080404b0\FileDescription',p,z);
  Ms.Write(p^,z-1);
  Ms.Write(ct,2);

  VerQueryValue(buff,'\StringFileInfo\080404b0\CompanyName',p,z);
  Ms.Write(p^,z-1);
  Ms.Write(ct,2);
  
  VerQueryValue(buff,'\StringFileInfo\080404b0\FileVersion',p,z);
  Ms.Write(p^,z-1);
  Ms.Write(ct,2);

  VerQueryValue(buff,'\StringFileInfo\080404b0\LegalCopyright',p,z);
  Ms.Write(p^,z-1);
  Ms.Write(ct,2);

  VerQueryValue(buff,'\StringFileInfo\080404b0\ProductName',p,z);
  Ms.Write(p^,z-1);
  Ms.Write(ct,2);

  VerQueryValue(buff,'\StringFileInfo\080404b0\ProductVersion',p,z);
  Ms.Write(p^,z-1);
  Ms.Write(ct,2);
  
  ms.Position:=0;
  sl.LoadFromStream(ms);

  MessageBox(Handle,PChar(sl.Text),'版本信息',48);
  FreeAndNil(Ms);
  FreeAndNil(sl);
  FreeMem(buff);
end;

end.

⌨️ 快捷键说明

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