+ Enhancements by Göran Andersson

install/demo/win32/menu.pp

@@ -1,204 +1,345 @@
-{
-  $Id$
+{   $Id$
   Copyright (c) 1999 by Michael van Canneyt
 
   Win32 menu creation example.
 }
-program menudemo;
+
+{ Changes by G”ran Andersson:                                  major
+  const FileMenus[] removed
+  const filename removed
+  type TFileName added
+  SelectFile() added                                           *
+  LoadText() added                                             *
+  SaveText():
+    SelectFile used                                            *
+    uses GetWindowTextLength & GetWindowText
+    also saves empty files
+    uses untyped file
+    FreeMem frees Len+1, not Len
+  AskSave() added                                              *
+  NewText() added                                              *
+  WindowProc():
+    WM_Close added
+    WM_Size don't assumes StatH=16
+    WM_Command 101 calls NewText
+    WM_Command 102 calls LoadText
+    WM_Command 104 issues a WM_Close instead of doing a Halt
+  WinRegister():
+    with structure used
+  EditCreate():
+    takes Status object as parameter
+    const EditText changed to empty string
+    unused variable DC removed
+    WS_HScroll & WS_VScroll added to const CS_Start
+    ES_AutoHScroll & ES_AutoVScroll removed from CS_Start
+    don't assumes StatH=16
+    AddText() commented out
+  WinCreate():
+    menu creation moved inside if structure
+    Options menu item uses the newly created SubMenu
+  main:
+    slight structure change (avoid unneccesary Exit)
+    call to StatusCreate before EditCreate
+
+2do:
+  make edit panel always active
+  add 3d inner bevel to edit panel
+  window background color : white
+  only ask to save if edited
+  cut
+  copy
+  paste
+  settings
+  help
+}
+
+Program menudemo;
 {$APPTYPE GUI}
 {$MODE DELPHI}
 
-uses Strings,Windows;
+Uses Strings,Windows;
+
+Const AppName = 'MenuDemo';
+
+Var AMessage: Msg;
+    hWindow,hStatus,Hedit: HWnd;
+    WindowClass: WndClass;
+    Menu: hMenu;
 
-const AppName='MenuDemo';
+Const 
+  EditMenus: Array[201..203] Of pchar = ('Cut','copy','paste');
 
-var AMessage:Msg;
-    hWindow,hStatus,Hedit : HWnd;
-    WindowClass:WndClass;
-    menu:hMenu;
+Type 
+  TFileName = Array[0..Max_Path] Of Char;
 
-Const FileMenus : Array[101..104] of pchar = ('New','Open','Save','Exit');
-      EditMenus : Array[201..203] of pchar = ('Cut','copy','paste');
-      Filename = 'edit.txt';
+Function SelectFile(Var FName:TFileName; Open:Boolean): Boolean;
+
+Const 
+  Filter: PChar = 'Text files (*.txt)'#0'*.txt'#0'All files (*.*)'#0'*.*'#0;
+  Ext: PChar = 'txt';
+
+Var 
+  NameRec: OpenFileName;
+Begin
+  FillChar(NameRec,SizeOf(NameRec),0);
+  FName[0] := #0;
+  With NameRec Do
+    Begin
+      LStructSize := SizeOf(NameRec);
+      HWndOwner := HWindow;
+      LpStrFilter := Filter;
+      LpStrFile := @FName;
+      NMaxFile := Max_Path;
+      Flags := OFN_Explorer Or OFN_HideReadOnly;
+      If Open Then
+        Begin
+          Flags := Flags Or OFN_FileMustExist;
+        End;
+      LpStrDefExt := Ext;
+    End;
+  If Open Then
+      SelectFile := GetOpenFileName(@NameRec)
+  Else
+      SelectFile := GetSaveFileName(@NameRec);
+End;
 
 Procedure SaveText;
 
-Var len : longint;
-    p : pchar;
-    f : text;
-    
-begin
-  Len:=SendMessage(Hedit,WM_GettextLength,0,0);
-  If Len=0 then
-     MessageBox(hWindow,FileMenus[103],'No length received',MB_OK or MB_ICONERROR);
-  GetMem(P,Len+1);
-  P[Len]:=#0;
-  P[SendMessage(HEdit,WM_GetText,LEN,Longint(P))]:=#0;
-  Assign(F,Filename);
-  rewrite(f);
-  Write(f,P);
-  Close(f);
-  FreeMem(P,Len);
-end;
-
-function WindowProc (Window:HWnd;AMessage,WParam,LParam:Longint):Longint;
-stdcall; export;
-var dc:hdc;
-    ps:paintstruct;
-    r:rect;
+Var Len: Longint;
+    P: PChar;
+    F: File;
+    FName: TFileName;
+Begin
+  If SelectFile(FName,False) Then
+    Begin
+      Assign(F,@FName);
+      Rewrite(F,1);
+      Len := GetWindowTextLength(HEdit);
+      GetMem(P,Len+1);
+      P[Len] := #0;
+      If Len>0 Then
+        Begin
+          GetWindowText(HEdit,P,Len+1);
+          BlockWrite(F,P^,Len);
+        End;
+      Close(F);
+      FreeMem(P,Len+1);
+    End;
+End;
+
+Procedure AskSave;
+Begin
+  If MessageBox(HWindow,'Save text?','Edited',MB_IconQuestion Or MB_YesNo)=IdYes Then
+    Begin
+      SaveText;
+    End;
+End;
+
+Procedure LoadText;
+
+Var 
+  FName: TFileName;
+  F: File;
+  Len: LongInt;
+  P: PChar;
+Begin
+  AskSave;
+  If SelectFile(FName,True) Then
+    Begin
+      Assign(F,@FName);
+      Reset(F,1);
+      Len := FileSize(F);
+      GetMem(P,Len+1);
+      P[Len] := #0;
+      If Len>0 Then BlockRead(F,P^,Len);
+      Close(F);
+      SetWindowText(HEdit,P);
+      FreeMem(P,Len+1);
+    End;
+End;
+
+Procedure NewText;
+
+Const 
+  Empty: PChar = '';
+Begin
+  AskSave;
+  SendMessage(HEdit,WM_SetText,1,LongInt(Empty));
+End;
+
+Function WindowProc (Window:HWnd;AMessage,WParam,LParam:Longint): Longint;
+stdcall;
+export;
+
+Var dc: hdc;
+    ps: paintstruct;
+    r: rect;
+    StatH: Word;
     nrmenu : longint;
+Begin
+  WindowProc := 0;
+  Case AMessage Of
+    wm_Paint:
+              Begin
+                dc := BeginPaint(Window,@ps);
+                GetClientRect(Window,@r);
+                EndPaint(Window,ps);
+                Exit;
+              End;
+    wm_Close:
+              Begin
+                AskSave;
+              End;
+    wm_Destroy:
+                Begin
+                  PostQuitMessage (0);
+                  Exit;
+                End;
+    wm_Size:
+             Begin
+               GetClientRect(HStatus,@R);
+               StatH := R.Bottom-R.Top;
+               GetClientRect(Window,@R);
+               MoveWindow (hStatus,r.left,r.bottom-StatH,r.right,r.bottom,true);
+               MoveWindow (HEdit,0,0,r.right-r.left,r.bottom-r.top-StatH,true);
+             End;
+    wm_Command:
+                Begin
+                  NrMenu := WParam And $FFFF;
+                  Case NrMenu Of
+                    101 : NewText;
+                    102 : LoadText;
+                    103 : SaveText;
+                    104 : PostMessage(Window,WM_Close,0,0);
+                    201..203: MessageBox(Window,EditMenus[NrMenu],
+                                         'Edit operation not implemented',MB_OK Or
+                                         MB_IconInformation);
+                  End;
+                End;
+  End;
+  WindowProc := DefWindowProc(Window,AMessage,WParam,LParam);
+End;
 
- begin
- WindowProc:=0;
- case AMessage of
-  wm_paint:
-   begin
-   dc:=BeginPaint (Window,@ps);
-   GetClientRect (Window,@r);
-   EndPaint (Window,ps);
-   Exit;
-   end;
-  wm_Destroy:
-   begin
-   PostQuitMessage (0);
-   Exit;
-   end;
-  wm_Size:
-   begin
-   GetClientRect (Window,@r);
-   MoveWindow (hStatus,r.left,r.bottom-16,r.right,r.bottom,true);
-   MoveWindow (HEdit,0,0,r.right-r.left,r.bottom-r.top-16,true);
-   end;
-  wm_command:
-   begin
-   NrMenu:=WParam and $FFFF;
-   Case NrMenu of
-     104 : Halt(0);
-     101..102: MessageBox(Window,FileMenus[NrMenu],'File Menu click received',MB_OK or MB_ICONINFORMATION);
-     103 : SaveTExt;
-     201..203: MessageBox(Window,EditMenus[NrMenu],'Edit operation not implemented',MB_OK or MB_ICONINFORMATION);
-   end;
-   end;
-  end;
- WindowProc:=DefWindowProc (Window,AMessage,WParam,LParam);
- end;
-
-function WinRegister:Boolean;
- 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(GRAY_BRUSH);
- WindowClass.lpszMenuName:='Files';
- WindowClass.lpszClassName:=AppName;
- Result:=RegisterClass (WindowClass)<>0;
- end;
-
-Const
-  CS_Start = WS_CHILD or ES_AUTOHSCROLL OR ES_AUTOVSCROLL OR ES_MULTILINE OR ES_LEFT;
-
-  EdiTText : Pchar = 'This is an edit text...';
-  Matchtext  = 'Left align in attribute';
-  NoMatchText = 'Left align not in attribute';
-  
-Function EditCreate (ParentWindow : HWnd) : HWnd;
-
-Var
-    hedit : HWND;
-    R : TRect;
-    DC : HDC;
-    
-    ta : longint;
-
-  Procedure AddText (S : String);
-  
+Function WinRegister: Boolean;
+Begin
+  With WindowClass Do
+    Begin
+      Style := cs_hRedraw Or cs_vRedraw;
+      lpfnWndProc := WndProc(@WindowProc);
+      cbClsExtra := 0;
+      cbWndExtra := 0;
+      hInstance := system.MainInstance;
+      hIcon := LoadIcon (0,idi_Application);
+      hCursor := LoadCursor (0,idc_Arrow);
+      hbrBackground := GetStockObject(GRAY_BRUSH);
+      lpszMenuName := 'Files';
+      lpszClassName := AppName;
+    End;
+  Result := RegisterClass (WindowClass)<>0;
+End;
+
+Function EditCreate(ParentWindow,Status:HWnd): HWnd;
+
+Const 
+  CS_Start = WS_Child or WS_HScroll or WS_VScroll or ES_MultiLine or ES_Left;
+  EdiTText: PChar = '';
+
+Var 
+  HEdit: HWND;
+  R: TRect;
+  StatH: Word;
+{                                             rev 1.5 : comment out
+  Procedure AddText (S:String);
   begin
     S:=S+#0;
     SendMessage(HEdit,em_replacesel,0,longint(pchar(@S[1])));
   end;
-    
-begin
- GetClientRect(ParentWindow,@r);
- ta:=CS_START; // AND NOT CS_OFF OR CS_ON;
- HEdit:=CreateWindow ('EDIT',EditText, ta,
-        0,0,R.RIght-R.Left,R.Bottom-R.top-16,ParentWindow,0,system.MainInstance,nil);
- If Hedit<>0 then begin
-   showwindow(Hedit,cmdShow);
-   updateWindow(HEdit);
-   end;
- Result:=HEdit;
-end;
-
-function WinCreate:HWnd;
-
-var hWindow:HWnd;
-    submenu : hmenu;
-
-
- begin
- hWindow:=CreateWindow (AppName,'MenuDemo',
-                        ws_OverlappedWindow,cw_UseDefault,cw_UseDefault,
-                        cw_UseDefault,cw_UseDefault,0,0,system.MainInstance,nil);
- menu:=CreateMenu;
- submenu:=createmenu;
- AppendMenu (submenu,MF_STRING,101,'&New...');
- AppendMenu (submenu,MF_STRING,102,'&Open...');
- AppendMenu (Submenu,MF_STRING,103,'&Save...');
- AppendMenu (Submenu,MF_SEPARATOR,0,Nil);
- AppendMenu (SubMenu,MF_String,104,'E&xit');
- AppendMenu (Menu,MF_POPUP,SubMenu,'&Files');
- submenu:=createmenu;
-  AppendMenu (SubMenu,MF_String,201,'&Cut');
- AppendMenu (SubMenu,MF_String,202,'&Copy');
- AppendMenu (SubMenu,MF_STRING,203,'&Paste');
- AppendMenu (Menu,MF_POPUP,SubMenu,'&Edit');
- SubMenu:=CreateMenu;
- AppendMenu (SubMenu,MF_STring,301,'&Settings');
- AppendMenu (menu,MF_STRING,0,'&Options');
- AppendMenu (menu,MF_STRING,0,'&Help');
- SetMenu (hWindow,menu);
- if hWindow<>0 then
-   begin
-   ShowWindow (hWindow,CmdShow);
-   UpdateWindow(hWindow);
-   end;
- Result:=hWindow;
- end;
-
-function StatusCreate (parent:hwnd):HWnd;
-
-begin
- StatusCreate:=CreateStatusWindow (WS_CHILD or
-  WS_VISIBLE,'Ready...',parent,$7712);
-end;
-
-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
-Else
-  Hedit:=EditCreate(HWindow);
-hstatus:=statuscreate (hwindow);
-while GetMessage (@AMessage,0,0,0) do
- begin
- TranslateMessage (AMessage);
- DispatchMessage (AMessage);
- end;
-Halt (AMessage.wParam);
-
-end.
+}
+Begin
+  GetClientRect(Status,@R);
+  StatH := R.Bottom-R.Top;
+  GetClientRect(ParentWindow,@R);
+  HEdit := CreateWindow ('EDIT',EditText,CS_Start,0,0,
+                       R.Right-R.Left,R.Bottom-R.top-StatH,ParentWindow,0,
+                       System.MainInstance,Nil);
+  If HEdit<>0 Then
+    Begin
+      ShowWindow(Hedit,cmdShow);
+      UpdateWindow(HEdit);
+    End;
+  Result := HEdit;
+End;
+
+Function WinCreate: HWnd;
+
+Var hWindow: HWnd;
+    SubMenu: hMenu;
+Begin
+  hWindow := CreateWindow (AppName,'MenuDemo',ws_OverlappedWindow,
+                         cw_UseDefault,cw_UseDefault,cw_UseDefault,
+                         cw_UseDefault,0,0,system.MainInstance,Nil);
+  If hWindow<>0 Then
+    Begin
+      Menu := CreateMenu;
+      SubMenu := CreateMenu;
+      AppendMenu(Submenu,MF_STRING,101,'&New...');
+      AppendMenu(Submenu,MF_STRING,102,'&Open...');
+      AppendMenu(Submenu,MF_STRING,103,'&Save...');
+      AppendMenu(Submenu,MF_SEPARATOR,0,Nil);
+      AppendMenu(SubMenu,MF_String,104,'E&xit');
+      AppendMenu(Menu,MF_POPUP,SubMenu,'&Files');
+      SubMenu := CreateMenu;
+      AppendMenu(SubMenu,MF_String,201,'&Cut');
+      AppendMenu(SubMenu,MF_String,202,'&Copy');
+      AppendMenu(SubMenu,MF_STRING,203,'&Paste');
+      AppendMenu(Menu,MF_POPUP,SubMenu,'&Edit');
+      SubMenu := CreateMenu;
+      AppendMenu(SubMenu,MF_String,301,'&Settings');
+      AppendMenu(Menu,MF_POPUP,SubMenu,'&Options');
+      AppendMenu(Menu,MF_STRING,0,'&Help');
+      SetMenu(hWindow,menu);
+      ShowWindow(hWindow,CmdShow);
+      UpdateWindow(hWindow);
+    End;
+  Result := hWindow;
+End;
+
+Function StatusCreate (parent:hwnd): HWnd;
+Begin
+  StatusCreate := CreateStatusWindow (WS_CHILD Or WS_VISIBLE,'Ready...',parent,$7712);
+End;
+
+Begin
+  If Not WinRegister Then
+    Begin
+      MessageBox (0,'Register failed',Nil, mb_Ok);
+    End
+  Else
+    Begin
+      hWindow := WinCreate;
+      If longint(hWindow)=0 Then
+        Begin
+          MessageBox (0,'WinCreate failed',Nil,MB_OK);
+        End
+      Else
+        Begin
+          HStatus := statuscreate(hwindow);
+          HEdit := EditCreate(HWindow,HStatus);
+          While GetMessage(@AMessage,0,0,0) Do
+          Begin
+            TranslateMessage(AMessage);
+            DispatchMessage(AMessage);
+          End;
+          Halt(AMessage.wParam);
+        End;
+    End;
+End.
+
+{   $Log$
+{   Revision 1.5  1999-08-10 08:20:49  michael
+{   + Enhancements by Göran Andersson
 {
-  $Log$
-  Revision 1.4  1999-07-16 12:20:57  michael
+  Revision 1.4  1999/07/16 12:20:57  michael
   + Added saving in fixed file
 
   Revision 1.3  1999/06/28 16:15:11  peter
@@ -207,4 +348,4 @@ end.
   Revision 1.2  1999/05/03 18:04:39  peter
     * updates
 
-}
+}