@会网络的老鼠

涂飞平的博客空间

陈经韬 的一个代码

12 年前 0

430074湖北省武汉市武昌民院路湖北经济管理大学计算机系(本)9801班
Http:Lovejingtao.126.com
E-Mail: Lovejingtao@21.cn.com
 

©CopyRight 2000-2001

来自:jingtao, 时间:2001-12-27 23:35:00, ID:817757
我跟他还是认识的.
用DELPHI写更加小都可以的.
陈经韬:
  家门,你好,我是音乐贺卡厂的作者陈亮。近日有人推荐我看看你的“EXE文件捆绑机”,主要是看您的图标更改功能。
  您的程序是用DELPHI编写的吗?如果是那就太好了,我们进行技术合作好吗?就是把您的更改图标技术应用到音乐贺卡厂中,并在音乐贺卡厂中特别说明,你看好吗?由于我们对图标更改不太熟悉,所以在技术上一直没有突破,早在一年前我就想图标更改技术应用到音乐贺卡厂中,使用户制作贺卡时可以更改贺卡文件图标。
  如果觉得可行,请您将更改程序图标的原理和DELPHI源程序发给我好吗?或者您还有什么建议告诉我也行,只要我们能够办得到的,我一定办到。好吗?音乐贺卡厂这项技术突破就靠你啦!:)
  先谢谢你再说吧!呵呵。有空联系。我的QQ号码是:590318。Email:software@ecardiy.com
========================================================
☆☆☆音乐贺卡厂☆☆☆   陈亮
http://www.ecardiy.com http://www.hesee.com
========================================================

来自:jingtao, 时间:2001-12-27 23:38:00, ID:817763
不用什么DLL的.下面是资源文件图片读取.
用流添加也很小的.
这个完全跟什么VC是没有关系的.

program Setup1;

uses Windows, Messages, myfile, CommCtrl;
{$R *.RES} //图标资源文件
{$R BMP_Image1.res} //图片资源文件
{$R Ver.res} //文件版本信息资源文件
const
ID_Open = 4001;
ID_Save = 4002;
ID_Close = 4003;
ID_Copy = 4004;
ID_Paste = 4005;
ID_About = 4006;
var
WinClass: TWndClassA;
Inst: HINST;
hWindow: HWND;
StatusBar1: HWND;
TheMessage: TMsg;
GroupBox1: HWND;
Edit1, Label1: HWND;
Button1: HWND;
MyMenu, MyMenuPop: HWND;
Memo1: HWND;
ProgressBar1: HWND;
Image1: HWND;
hImage1: HBITMAP;
Button2: HWND;
Button3: HWND;
// PaintStruct: TPaintStruct;
// PaintDC: HDC;
hFont: Integer;
{ Custom WindowProc function }

procedure My_CreateMenu;
begin
MyMenu := CreateMenu();

MyMenuPop := CreateMenu();
AppendMenu(MyMenuPop, MF_STRING, ID_Open, '打开(&Open)');
AppendMenu(MyMenuPop, MF_SEPARATOR, 0, nil);
AppendMenu(MyMenuPop, MF_STRING, ID_Save, '保存(&Save)');
AppendMenu(MyMenuPop, MF_SEPARATOR, 0, nil);
AppendMenu(MyMenuPop, MF_STRING, ID_Close, '关闭(&Close)');
AppendMenu(MyMenu, MF_POPUP, MyMenuPop, '文件(&File)');

MyMenuPop := CreateMenu();
AppendMenu(MyMenuPop, MF_STRING, ID_Copy, '复制(&Open)');
AppendMenu(MyMenuPop, MF_SEPARATOR, 0, nil);
AppendMenu(MyMenuPop, MF_STRING, ID_Paste, '粘贴(&Save)');
AppendMenu(MyMenu, MF_POPUP, MyMenuPop, '编辑(&Edit)');

MyMenuPop := CreateMenu();
AppendMenu(MyMenuPop, MF_STRING, ID_About, '关于(&About)');
AppendMenu(MyMenu, MF_POPUP, MyMenuPop, '帮助(&Help)');

end;

procedure My_SetProgress(i: integer);
begin
SendMessage(ProgressBar1, PBM_SETPOS, i, 0);
end;

function My_Gettext: string;
var
Textlength: Integer;
Text: PChar;
s: string;
begin
TextLength := GetWindowTextLength(Edit1);
GetMem(Text, TextLength + 1);
GetWindowText(Edit1, Text, TextLength + 1);
s := text;
FreeMem(Text, TextLength + 1);
Result := s;
end;

function WindowProc(hWindow: HWnd; Message, wParam, lParam: Integer): Integer; stdcall;
var
sdir: string; //安装目录
i: integer; //进度条
begin
Result := 0;
{ Checks for messages }
case Message of
WM_CREATE:
begin
{ Load Image }
hImage1 := LoadBitmap(Inst, PChar('BMP_Image1'));
end;
WM_SIZE:
begin
SendMessage(StatusBar1, WM_SIZE, wParam, lParam);
end;
WM_COMMAND:
begin
if HWND(lParam) = Button1 then
if SelectDirectory(hWindow, '请选择安装目录', '', sdir)
then SetWindowText(Edit1, pchar(sdir));
if HWND(lParam) = Button2 then
begin
if My_Gettext = '' then
begin
MessageBox(hWindow, '请先选择安装文件夹!', '信息', MB_ICONINFORMATION + MB_OK);
Exit;
end;

{ if FileExists(pchar(My_Gettext + Getmyname)) then
if MessageBox(hWindow, pchar('文件' + My_Gettext + Getmyname + '已经存在,你确定继续安装吗?'), '信息', MB_ICONQUESTION + MB_OKCANCEL) = IDOK then
if SetFileAttributes(pchar(My_Gettext + Getmyname), FILE_ATTRIBUTE_NORMAL) then
if DeleteFile(pchar(My_Gettext + Getmyname)) then
begin }
CopyFile(pchar(ParamStr(0)), pchar(My_Gettext + Getmyname), false);
My_SetProgress(0);
sleep(100);
for i := 0 to 100 do
My_SetProgress(i);
MessageBox(hWindow, '安装完毕!', '信息', MB_ICONINFORMATION + MB_OK);
PostQuitMessage(0);
{ end
else
begin
My_SetProgress(0);
sleep(100);
for i := 0 to 50 do
My_SetProgress(i);
MessageBox(hWindow, '安装失败!', '信息', MB_ICONERROR + MB_OK);
PostQuitMessage(0);

end; }
Exit;
end;
if HWND(lParam) = Button3 then
begin
PostQuitMessage(0);
Exit;
end;
{The Message is Menu}
case HWND(wParam) of
ID_Open:
begin
MessageBox(hWindow, '你点击了菜单“打开”!', '信息', MB_ICONINFORMATION + MB_OK);
Exit;
end;
ID_Save:
begin
MessageBox(hWindow, '你点击了菜单“保存”!', '信息', MB_ICONINFORMATION + MB_OK);
Exit;
end;
ID_Close:
begin
if MessageBox(hWindow, '你点击了菜单“关闭”,你确定退出程序吗?', '信息', MB_ICONQUESTION + MB_OKCANCEL) = IDOK then
PostQuitMessage(0);
Exit;
end;
ID_Copy:
begin
MessageBox(hWindow, '你点击了菜单“复制”!', '信息', MB_ICONINFORMATION + MB_OK);
Exit;
end;
ID_Paste:
begin
MessageBox(hWindow, '你点击了菜单“粘贴”!', '信息', MB_ICONINFORMATION + MB_OK);
Exit;
end;
ID_About:
begin
MessageBox(hWindow, '本程序主要想说明如何用VC+Delphi做一个窗口,是<>教程的第一个例子程序。如果直接用普通方法来写,程序大小将为338KB(Delphi5下),现在请看看文件的大小!教程和原代码可以在Http://Lovejingtao.126.com下载.', '关于', MB_ICONINFORMATION + MB_OK);
Exit;
end;
end; //end case

exit;
end;

WM_DESTROY:
begin
{ Delete Pens and Brushes }
{ Delete Fonts }
PostQuitMessage(0);
Exit;
end;
else
Result := DefWindowProc(hWindow, Message, wParam, lParam);
end;
end;

begin
{ Register Custom WndClass }
Inst := hInstance;
with WinClass do
begin
style := CS_CLASSDC or CS_PARENTDC;
lpfnWndProc := @WindowProc;
hInstance := Inst;
hbrBackground := color_btnface + 1;
lpszClassname := 'MyWindowClass';
hIcon := LoadIcon(Inst, 'Mainicon');
hCursor := LoadCursor(0, IDC_ARROW);
end; { with }

RegisterClass(WinClass);

My_CreateMenu; {Create Main Menu}
{ Create Main Window }
hWindow := CreateWindowEx(WS_EX_WINDOWEDGE, 'MyWindowClass', '我的安装程序',
WS_MINIMIZEBOX or WS_SYSMENU or WS_VISIBLE,
(GetSystemMetrics(SM_CXSCREEN) - 300) div 2,
(GetSystemMetrics(SM_CYSCREEN) - 330) div 2, 300, 330, 0, MyMenu, Inst, nil);
{ Create a label (static) ========================================= }
Label1 := Createwindow('Static', 'Label1', WS_VISIBLE or WS_CHILD or SS_LEFT,
48, 4, 182, 83, hWindow, 0, Inst, nil);
SendMessage(Label1, WM_SETTEXT, 0, lParam(pChar('第一个范例程序:程序自拷贝。')));

{ Create a groupbox =============================================== }
GroupBox1 := CreateWindow('Button', '安装路径:', WS_VISIBLE or WS_CHILD or BS_GROUPBOX,
0, 19, 291, 177, hWindow, 0, Inst, nil);

{ Create an edit field ============================================ }
Edit1 := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', 'C:', WS_CHILD or WS_VISIBLE or WS_BORDER or WS_TABSTOP,
18, 39, 177, 21, hWindow, 0, Inst, nil);

{ Create a button ================================================= }
Button1 := CreateWindow('Button', '浏览', WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT or WS_TABSTOP,
202, 37, 75, 25, hWindow, 0, Inst, nil);

{ Create a memo =================================================== }
Memo1 := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', '', WS_CHILD or WS_VISIBLE or WS_BORDER or
ES_LEFT or ES_MULTILINE or ES_WANTRETURN or ES_AUTOVSCROLL or WS_VSCROLL,
18, 71, 257, 95, hWindow, 0, Inst, nil);
{ add lines to memo }
SendMessage(Memo1, WM_SETTEXT, 0, lParam(pChar(' 点击“浏览”按钮允许你从文件夹子目录结构中选择目标文件夹。' + #13#10 + ' 请点击“安装”按钮开始安装程序。' + #13#10 + ' 本安装程序是用Delphi5.0写的。具体信息请看文件版本信息。')));

{ Create a static image =========================================== }
Image1 := CreateWindow('Static', '', WS_VISIBLE or WS_CHILD or SS_BITMAP,
16, 228, 32, 32, hWindow, 0, Inst, nil);
{ set image to static control }
SendMessage(Image1, STM_SETIMAGE, IMAGE_BITMAP, LParam(hImage1));

{ Create a button ================================================= }
Button2 := CreateWindow('Button', '安装', WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT or WS_TABSTOP,
88, 232, 75, 25, hWindow, 0, Inst, nil);

{ Create a button ================================================= }
Button3 := CreateWindow('Button', '退出', WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT or WS_TABSTOP,
188, 232, 75, 25, hWindow, 0, Inst, nil);

{ Create a progressbar ============================================ }
ProgressBar1 := CreateWindow('msctls_progress32', 'progressbar', WS_VISIBLE or WS_CHILD or WS_BORDER,
8, 204, 281, 18, hWindow, 0, Inst, nil);
SendMessage(ProgressBar1, PBM_SETRANGE, 0, MakeLong(0, 100));
SendMessage(ProgressBar1, PBM_SETPOS, 0, 0);

{ Create a statusbar ============================================== }
StatusBar1 := CreateStatusWindow(WS_VISIBLE or WS_CHILD, ''
, hWindow, 0);

hFont := CreateFont(-13, 0, 0, 0, 400, 0, 0, 0, ANSI_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, '宋体');

if hFont 0 then
begin
SendMessage(Button1, WM_SETFONT, hFont, 0);
SendMessage(Button2, WM_SETFONT, hFont, 0);
SendMessage(Button3, WM_SETFONT, hFont, 0);
SendMessage(edit1, WM_SETFONT, hFont, 0);
SendMessage(Memo1, WM_SETFONT, hFont, 0);
SendMessage(Label1, WM_SETFONT, hFont, 0);
SendMessage(GroupBox1, WM_SETFONT, hFont, 0);
end;

//SetFocus(Edit1);

UpdateWindow(hWindow);

{the standard message loop}
while GetMessage(TheMessage, 0, 0, 0) do
begin
if not IsDialogMessage(hWindow, TheMessage) then
begin
TranslateMessage(TheMessage);
DispatchMessage(TheMessage);
end;
end;
end.

-------------------------------------------
unit Myfile;

interface

uses
Windows, shlobj;
//if SelectDirectory(handle,'请选择安装目录','',sdir)
//function FileExists(Filename: PCHAR): BOOLEAN;
function Getmyname: string;
function SelectDirectory(handle: hwnd; const Caption: string; const Root: WideString; out Directory: string): Boolean;
implementation
function Getmyname: string;
var
i, j: integer;
begin
J := 3;
for i := 1 to length(ParamStr(0)) do
if ParamStr(0) = '' then J := I;
Result := copy(ParamStr(0), J + 1, length(ParamStr(0)) - J);
end;
function SelectDirectory(handle: hwnd; const Caption: string; const Root: WideString; out Directory: string): Boolean;
var
lpbi: _browseinfo;
buf: array[0..MAX_PATH] of char;
id: ishellfolder;
eaten, att: cardinal;
rt: pitemidlist;
initdir: pwidechar;
begin
result := false;
lpbi.hwndOwner := handle;
lpbi.lpfn := nil;
lpbi.lpszTitle := pchar(caption);
lpbi.ulFlags := BIF_RETURNONLYFSDIRS + BIF_EDITBOX;
SHGetDesktopFolder(id);
initdir := pwchar(root);
id.ParseDisplayName(0, nil, initdir, eaten, rt, att);
lpbi.pidlRoot := rt;
getmem(lpbi.pszDisplayName, MAX_PATH);
try
result := shgetpathfromidlist(shbrowseforfolder(lpbi), buf);
except
freemem(lpbi.pszDisplayName);
end;
if result then
begin
directory := buf;
if length(directory) 3 then directory := directory + '';
end;
end;

{function FileExists(Filename: PCHAR): BOOLEAN;
function StrLen(Str: PCHAR): WORD;

var
i: WORD;

begin

i := 0;
while Str #0 do
inc(i);

RESULT := i;

end;
function FixDirChar(s: PCHAR): PCHAR;

var
i: BYTE;

begin

for i := 0 to StrLen(s) do
if s = '/' then
s := '';

RESULT := s;

end;

var
SearchRec: TWin32FindData;
i, Handle: INTEGER;
FN: PCHAR;

begin

if Filename[StrLen(Filename) - 1] = '' then
begin
GETMEM(FN, 255);
for i := 0 to StrLen(Filename) - 1 do
FN := Filename;

FN := '*';
FN[i + 1] := '.';
FN[i + 2] := '*';
FN[i + 3] := #0;

try
HANDLE := FindFirstFile(FixDirChar(FN), SearchRec)
finally
DISPOSE(FN);
end;

end
else
HANDLE := FindFirstFile(FixDirChar(Filename), SearchRec);

FindClose(HANDLE);
RESULT := HANDLE INVALID_HANDLE_VALUE;

end; }

end.

编写评论