怎样在pascal中写一个窗体???并显示出来!!!(50分)

  • 主题发起人 主题发起人 ilovezlaner
  • 开始时间 开始时间
program AutoShutDown;

uses
Windows,
ShellAPI,
Sysutils,
Messages;

{$R *.RES}
var
WinClass: TWndClassA;
Handle: hwnd;
Inst, Button1, Label1, Edit1: Integer;
Msg: TMsg;
tid: TNotifyIconDataA;
sdt: tdatetime;
timerid: integer;
hFont: Integer;
const
AppName = 'AutoShutDown';
st = '定时关机';
About = st + ' 1.0, Keyes.chen@263.net, Keyes 1999.10.23';
gjs = '设定关机时间';

procedure SetShutdownTime;
var
Textlength: Integer;
Text: PChar
i: tdatetime;
begin
TextLength := GetWindowTextLength(Edit1);
GetMem(Text, TextLength + 1);
GetWindowText(Edit1, Text, TextLength + 1);
try
i := Strtodatetime(Text);
if i <= now then
begin
MessageBox(handle, '不对吧!太早了.', '错误', mb_ok or MB_ICONERROR);
exit;
end;
sdt := i;
timerid := Settimer(handle, 1000, 1000, nil);
Showwindow(handle, sw_hide);
lstrcpy(tid.szTip, pchar(st + ' 关机时间:' + Datetimetostr(sdt)));
Shell_NotifyIcon(nim_modify, @tid);
except
Killtimer(handle, timerid);
Messagebox(handle, pchar('关机时间设定错误'#13#10#13#10 + '格式因该是:' + Datetimetostr(now)), AppName, Mb_ok or MB_ICONINFORMATION);
end;
FreeMem(Text, TextLength + 1);
end;

function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer
stdcall;
var pt: tpoint
pm: Hmenu;
begin
result := 0;
case uMsg of
wm_timer:
begin
if now >= sdt then
begin
Killtimer(handle, timerid);
ExitWindowsEx(EWX_SHUTDOWN or EWX_Force, 0);
// PostMessage(handle,wm_Destroy,0,0);
end;
end;
wm_User:
begin
case lparam of
WM_LBUTTONDBLCLK:
begin
showwindow(handle, sw_restore);
setforegroundwindow(handle);
end;
wm_LButtonDown, wm_RButtonDown:
begin
GetCursorPos(pt);
pm := CreatePopupMenu;
AppendMenu(pm, 0, Ord('S'), gjs);
AppendMenu(pm, 0, Ord('A'), '关于...');
AppendMenu(pm, mf_Separator, 0, nil);
AppendMenu(pm, 0, Ord('E'), '退出');
SetForegroundWindow(handle);
if TrackPopupMenu(pm, tpm_BottomAlign or tpm_RightAlign, pt.x, {GetDeviceCaps(dc,Vertres)} pt.y, 0, handle, nil) then
SetForegroundWindow(handle);
DestroyMenu(pm)
end;
end;
end;
wm_Destroy:
begin
Shell_NotifyIcon(nim_Delete, @tid);
Killtimer(handle, timerid);
halt;
end;
wm_Command:
begin
if (lParam = Button1) then begin SetshutdownTime
exit end;
case Loword(wParam) of
Ord('A'): MessageBox(0, About, AppName, mb_ok or MB_ICONINFORMATION);
Ord('E'): PostMessage(handle, wm_Close, 0, 0);
Ord('S'):
begin
Showwindow(handle, sw_restore);
end;
end;
end;
end;
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;

begin
{ ** Register Custom WndClass ** }
if FindWindow(AppName, nil) <> 0 then begin
Messagebox(handle, '已经有一个AutoShutDown运行了', AppName, mb_ok or MB_ICONWARNING);
halt(0);
end;
Inst := hInstance;
with WinClass do
begin
style := CS_CLASSDC or CS_PARENTDC;
lpfnWndProc := @WindowProc;
hInstance := Inst;
hbrBackground := color_btnface + 1;
lpszClassname := AppName;
hCursor := LoadCursor(0, IDC_ARROW);
end;
RegisterClass(WinClass);
Handle := CreateWindowEx(WS_EX_WINDOWEDGE, AppName, 'AutoShutDown 1.00',
WS_VISIBLE {or WS_SIZEBOX} or WS_CAPTION or WS_SYSMENU,
283, 238, 325, 65, 0, 0, Inst, nil);
Button1 := CreateWindow('Button', 'OK', WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT,
236, 8, 75, 20, handle, 0, Inst, nil);
Label1 := Createwindow('Static', '', WS_VISIBLE or WS_CHILD or SS_LEFT,
8, 12, 80, 13, Handle, 0, Inst, nil);
Edit1 := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', Pchar(Datetimetostr(now)), WS_CHILD or WS_VISIBLE or
WS_BORDER {or ES_PASSWORD}, 88, 8, 141, 21, Handle, 0, Inst, nil);
hFont := CreateFont(-12, 0, 0, 0, 500, 0, 0, 0, GB2312_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(Label1, WM_SETFONT, hFont, 0);
SendMessage(Edit1, WM_SETFONT, hFont, 0);
end;
SetWindowText(Label1, pchar(gjs + ':'));
SetFocus(Edit1);
UpdateWindow(Handle);
tid.cbSize := sizeof(tid);
tid.Wnd := handle;
tid.uID := 1;
tid.uFlags := nif_Message or nif_Icon or nif_Tip;
tid.uCallBackMessage := wm_User;
tid.hIcon := LoadIcon(hInstance, 'MAINICON');
lstrcpy(tid.szTip, st);
Shell_NotifyIcon(nim_Add, @tid);
while (GetMessage(Msg, Handle, 0, 0)) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end.
这个资料你瞧瞧吧
 
如果看不明白app2001的。
去看看李維的《inside VCL》第一章,裡面提到了有講的。
 
老兄:
是在object pascal里面写窗体。。。。。。
不是在delphi里面写窗体。。。。
 
可以参照一下函数的代码
function GetString(Var sResult:string
sDef:string
iMaxLen:Integer):Boolean;
var
Form: TForm;
Prompt: TLabel;
Edit: TEdit;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
Result := False;
Form := TForm.Create(Application);
with Form do
try
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
BorderStyle := bsDialog;
Caption := '提示';
ClientWidth := MulDiv(180, DialogUnits.X, 4);
ClientHeight := MulDiv(63, DialogUnits.Y, 8);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
AutoSize := True;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Caption := '请输入:';
end;
Edit := TEdit.Create(Form);
with Edit do
begin
Parent := Form;
Left := Prompt.Left;
Top := MulDiv(19, DialogUnits.Y, 8);
Width := MulDiv(164, DialogUnits.X, 4);
MaxLength := 255;
Text := sDef;
SelectAll;
end;
ButtonTop := MulDiv(41, DialogUnits.Y, 8);
ButtonWidth := MulDiv(50, DialogUnits.X, 4);
ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
with TButton.Create(Form) do
begin
Parent := Form;
Caption := '确定';
ModalResult := mrOk;
Default := True;
SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
ButtonHeight);
end;
with TButton.Create(Form) do
begin
Parent := Form;
Caption := '取消';
ModalResult := mrCancel;
Cancel := True;
SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
ButtonHeight);
end;
if ShowModal = mrOk then
begin
sResult := Edit.Text;
Result := True;
end;
finally
Form.Free;
end;
end;
 
哦,那就当我没说了
 
打开Delphi的单元文件看下怎么创建的。
不知道你的用途是?
 
yaoc:
在object pascal 中怎么还有Tform,Tlabel之类的东西哟???
是在object pascal而不是在delphi中。。。。。。
谢谢!!!
 
明白,无法为你效劳!:(
 
不用VCL,而使用SDK写出的窗体

program WindowDemo;

uses Windows, Messages;

// 窗口函数,窗口接到消息时被Windows所调用
function WindowProc(hwnd : HWND
uMsg : Cardinal
wParam : WPARAM;
lParam : LPARAM) : LResult
stdcall;
begin
Result := 0;

case uMsg of
// 关闭窗口消息,当用户关闭窗口后,通知主消息循环结束程序
WM_CLOSE : PostMessage(hwnd, WM_QUIT, 0, 0)

// 鼠标左键按下消息
WM_LBUTTONDOWN : MessageBox(hwnd, 'Hello!', '和您打个招呼',
MB_ICONINFORMATION)


else
// 其它消息做默认处理
Result := DefWindowProc(hWnd, uMsg, wParam, lParam)

end;
end;

var
wndcls : WNDCLASS
// 窗口类的记录(结构)类型
hWnd : THandle;
Msg : tagMSG
// 消息类型
begin
wndcls.style := CS_DBLCLKS
// 允许窗口接受鼠标双击
wndcls.lpfnWndProc := @WindowProc
// 为窗口类指定窗口函数
wndcls.cbClsExtra := 0;
wndcls.cbWndExtra := 0;
wndcls.hInstance := hInstance;
wndcls.hIcon := 0;
wndcls.hCursor := LoadCursor(hInstance, 'IDC_ARROW');
wndcls.hbrBackground := COLOR_WINDOWFRAME;
wndcls.lpszMenuName := nil;
wndcls.lpszClassName := 'WindowClassDemo'
// 窗口类名称

// 注册窗口类
if RegisterClass(wndcls) = 0 then
Exit;

// 创建窗口
hWnd := CreateWindow(
'WindowClassDemo', // 窗口类名称
'WindowDemo', // 窗口名称
WS_BORDER or WS_CAPTION or WS_SYSMENU, // 窗口类型
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
0,
0,
hInstance,
nil
);
if hWnd = 0 then
Exit;

// 显示窗口
ShowWindow(hWnd, SW_SHOWNORMAL);
UpdateWindow(hWnd);

// 创建主消息循环,处理消息队列中的消息并分发
// 直至收到WM_QUIT消息,退出主消息循环,并结束程序
// WM_QUIT消息由PostMessage()函数发送
while GetMessage(Msg, hWnd, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
 
wr960204的代码还有点意思,试试看!!!!!
 
同意wr960204的
 
接受答案了.
 
后退
顶部