2
0
florian 27 жил өмнө
parent
commit
3a46ae8390
1 өөрчлөгдсөн 118 нэмэгдсэн , 0 устгасан
  1. 118 0
      install/demo/win32/hello.pp

+ 118 - 0
install/demo/win32/hello.pp

@@ -0,0 +1,118 @@
+{
+  $Id$
+  Copyright (c) 1996 by Charlie Calvert
+  Modifications by Florian Klaempfl
+
+  Standard Windows API application written in Object Pascal.
+  No VCL code included. This is all done on the Windows API
+  level.
+}
+
+{$APPTYPE GUI}
+{$MODE DELPHI}
+program Window1;
+
+uses
+  Strings, Windows;
+
+const
+  AppName = 'Window1';
+
+function WindowProc(Window: HWnd; AMessage, WParam,
+                    LParam: Longint): Longint; stdcall; export;
+
+  var
+     dc : hdc;
+     ps : paintstruct;
+     r : rect;
+
+begin
+  WindowProc := 0;
+
+  case AMessage of
+    wm_paint:
+      begin
+         dc:=BeginPaint(Window,@ps);
+         GetClientRect(Window,@r);
+         DrawText(dc,'Hello world by Free Pascal',-1,@r,
+           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
+         EndPaint(Window,ps);
+         Exit;
+      end;
+    wm_Destroy:
+      begin
+         PostQuitMessage(0);
+         Exit;
+      end;
+  end;
+
+  WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
+end;
+
+ { Register the Window Class }
+function WinRegister: Boolean;
+var
+  WindowClass: WndClass;
+begin
+  WindowClass.Style := cs_hRedraw or cs_vRedraw;
+  WindowClass.lpfnWndProc := WndProc(@WindowProc);
+  WindowClass.cbClsExtra := 0;
+  WindowClass.cbWndExtra := 0;
+  WindowClass.hInstance := system.MainInstance;
+  WindowClass.hIcon := LoadIcon(0, idi_Application);
+  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
+  WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
+  WindowClass.lpszMenuName := nil;
+  WindowClass.lpszClassName := AppName;
+
+  Result := RegisterClass(WindowClass) <> 0;
+end;
+
+ { Create the Window Class }
+function WinCreate: HWnd;
+var
+  hWindow: HWnd;
+begin
+  hWindow := CreateWindow(AppName, 'Hello world program',
+              ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
+              cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);
+
+  if hWindow <> 0 then begin
+    ShowWindow(hWindow, CmdShow);
+    UpdateWindow(hWindow);
+  end;
+
+  Result := hWindow;
+end;
+
+
+var
+  AMessage: Msg;
+  i : byte;
+  hWindow: HWnd;
+  exename : pchar;
+
+begin
+  if not WinRegister then begin
+    MessageBox(0, 'Register failed', nil, mb_Ok);
+    Exit;
+  end;
+  hWindow := WinCreate;
+  if longint(hWindow) = 0 then begin
+    MessageBox(0, 'WinCreate failed', nil, mb_Ok);
+    Exit;
+  end;
+
+  while GetMessage(@AMessage, 0, 0, 0) do begin
+    TranslateMessage(AMessage);
+    DispatchMessage(AMessage);
+  end;
+  Halt(AMessage.wParam);
+end.
+
+{
+  $Log$
+  Revision 1.1  1998-10-27 15:22:35  florian
+    + Initial revision
+
+}