📄 unit1.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 + -