About/Contact

Steve Trefethen

Steve Trefethen is a Director of Engineering at Reply. Contact me

View my LinkedIn profile


Powered by discountASP.NET
referal ID: sdtref
Why recommend discountASP.NET?
$720 in referrals so far!


Calendar

<<  February 2012  >>
MoTuWeThFrSaSu
303112345
6789101112
13141516171819
20212223242526
2728291234
567891011

View posts in large calendar

Disclaimer

The posts on this weblog are provided AS IS with no warranties, and confer no rights. The opinions expressed herein are my own personal opinions and do not represent my employer's view in any way.



A generic Windows application written in Object Pascal

April 06 2007 9:03PM
This is a bit of a throw back to Delphi 1.0 days. Recently, we were wanting to see exactly what messages Windows sent when maxmimizing/minimizing/restoring an application without the impact of any sort of framework like the VCL. Thus we resurrected Generic.pas from Delphi 1.0 and below is a copy that  compiles/executes with Delphi 2007. This code can also be useful for playing around with code snippets Raymond Chen posts on his blog. Here's a post where he explains why he uses code like this in the first place.

You can download the .DPR along with the .RC/.RES files here.
1 {************************************************} 2 { } 3 { Demo program } 4 { Copyright (c) 1991, 2007 by CodeGear } 5 { } 6 {************************************************} 7 8 { "Generic" Windows application written in Turbo Pascal } 9 10 program Generic; 11 12 {$R GENERIC.RES} 13 {$WARN SYMBOL_PLATFORM OFF} 14 15 uses Messages, Windows; 16 17 const 18 SAppName = 'Generic'; 19 SAboutBox = 'AboutBox'; 20 SWindowName = 'Turbo Pascal Generic'; 21 22 const 23 idm_About = 100; 24 25 function About(Dialog: HWnd; Message, WParam: Longint; 26 LParam: Longint): Bool; stdcall; 27 begin 28 About := True; 29 case Message of 30 wm_InitDialog: 31 Exit; 32 wm_Command: 33 if (WParam = id_Ok) or (WParam = id_Cancel) then 34 begin 35 EndDialog(Dialog, 1); 36 Exit; 37 end; 38 end; 39 About := False; 40 end; 41 42 function WindowProc(Window: HWnd; Message, WParam: Longint; 43 LParam: Longint): Longint; stdcall; 44 begin 45 Result := 0; 46 case Message of 47 wm_Command: 48 if WParam = idm_About then 49 begin 50 DialogBox(HInstance, SAboutBox, Window, @About); 51 Exit; 52 end; 53 wm_Destroy: 54 begin 55 PostQuitMessage(0); 56 Exit; 57 end; 58 end; 59 Result := DefWindowProc(Window, Message, WParam, LParam); 60 end; 61 62 var 63 WindowClass: TWndClass = ( 64 style: 0; 65 lpfnWndProc: @WindowProc; 66 cbClsExtra: 0; 67 cbWndExtra: 0; 68 hInstance: 0; 69 hIcon: 0; 70 hCursor: 0; 71 hbrBackground: COLOR_WINDOW; 72 lpszMenuName: SAppName; 73 lpszClassName: SAppName); 74 75 procedure WinMain; 76 var 77 Window: HWnd; 78 Message: TMsg; 79 begin 80 { Register the window class } 81 WindowClass.hInstance := HInstance; 82 WindowClass.hIcon := LoadIcon(0, idi_Application); 83 WindowClass.hCursor := LoadCursor(0, idc_Arrow); 84 if Windows.RegisterClass(WindowClass) = 0 then 85 Halt(1); 86 { Create and show the window } 87 Window := CreateWindow(SAppName, SWindowName, ws_OverlappedWindow, 88 Integer(cw_UseDefault), Integer(cw_UseDefault), 320, 240, 89 0, 0, HInstance, nil); 90 ShowWindow(Window, CmdShow); 91 UpdateWindow(Window); 92 { and crank up a message loop } 93 while GetMessage(Message, 0, 0, 0) do 94 begin 95 TranslateMessage(Message); 96 DispatchMessage(Message); 97 end; 98 Halt(Message.wParam); 99 end; 100 101 begin 102 WinMain; 103 end.
FacebookDel.icio.usDigg It!

Tags:

Comments (9) -

4/6/2007 10:06:31 PM #

The good ol' Visual Studio barebone win32 project! Do we really need anything else anyway?

What even nicer is to check out the size of the executable the above code generates!

Eric Fortier

4/6/2007 10:07:09 PM #

The link sends me to Raymond Fork Lift Company. Is this what was intended.

Tom

4/6/2007 10:27:27 PM #

Hi Tom,
  I used a macro which for an "I'm feeling lucky" Google search on Raymond's name but apparently that's not universal. For me I get right where I expected but obviously that's not the case for everyone. I've now hard coded the link so thanks for letting me know.

Steve Trefethen

4/7/2007 8:00:54 PM #

shouldn't the keywords be uppercase Smile

Thaddy de Koning

4/8/2007 6:16:11 PM #

MakeProcInstance/FreeProcInstance are not needed in Win32 and listed as obsolete.

M J Marshall

4/8/2007 10:29:49 PM #

M J,
  Good catch. Fixed.

Steve Trefethen

4/9/2007 6:42:40 PM #

Hi Steve,

Cool revival! ;)

A couple of tips:

Replace
    hbrBackground: 0;
with
    hbrBackground: COLOR_WINDOW;

to fix the painting issues (as you don't explicitly handle WM_PAINT) - this ensures that the default message handling erases the background of the window with a properly colored brush.

Replacing
  if Windows.RegisterClass(WindowClass) = 0 then
    RaiseLastOSError;
with something like
  if Windows.RegisterClass(WindowClass) = 0 then
    Halt(1);                  
Allows you to remove the SysUtils reference from the uses,

uses Messages, Windows;

trimming the size of the .EXE even more.

Hallvard Vassbotn

4/9/2007 7:06:22 PM #

Hey Hallvard,
  I figured after we revived this people might enjoy it. Btw, I've made the suggested changes. Thanks!

Steve Trefethen

4/9/2007 10:23:00 PM #

An ealier comment suggested that the hbrBackground should be set to COLOR_WINDOW.  I expect this works just fine but I learned in my Petzold days (back to which seeing this took me) that you should assign: hbrBackground: COLOR_WINDOW + 1;

Chris Trueman

Add comment




  Country flag
biuquote
  • Comment
  • Preview
Loading