* Initial revision

install/demo/win32/edit.pp

@@ -0,0 +1,348 @@
+{
+  $Id$
+  Copyright (c) 1999 by Michael van Canneyt and Goran Andersson
+
+  Win32 editor example.
+}
+
+{ Derived from menu.pp
+
+  Changes by Goeran Andersson:
+
+  2000.02.20
+    Sends focus to editor
+
+  2000.02.19
+    Client edge added to editor
+    Changes to also compile in FPC mode
+    Handles Edit modify flag
+    Undo menu item added
+    Key codes added to edit menu
+    Undo, Cut, Copy & Paste implemented
+    WM_Paint sections commented
+
+
+  1999.08.10
+    LoadText() added
+    NewText() added
+    File selector added
+    Asks to save file
+    Empty files works
+    EditCreate styles corrected
+
+2do:
+  reduce flickering when resizing
+  use the status bar for something
+}
+
+Program editdemo;
+{$APPTYPE GUI}
+{$MODE DELPHI}
+
+Uses Strings,Windows;
+
+Const AppName = 'EditDemo';
+
+Var AMessage: Msg;
+    HWindow,HStatus,HEdit: HWnd;
+
+Type
+  TFileName = Array[0..Max_Path] Of Char;
+
+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: 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;
+
+Const
+  BoxType=MB_IconQuestion Or MB_YesNo;
+Begin
+  If SendMessage(HEdit,EM_GetModify,0,0)<>0 Then
+    Begin
+      If MessageBox(HWindow,'Save text?','Edited',BoxType)=IdYes Then
+        Begin
+          SaveText;
+        End;
+    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);
+      SendMessage(HEdit,EM_SetModify,0,0);
+      FreeMem(P,Len+1);
+    End;
+End;
+
+Procedure NewText;
+
+Const
+  Empty: PChar = '';
+Begin
+  AskSave;
+  SendMessage(HEdit,WM_SetText,1,LongInt(Empty));
+  SendMessage(HEdit,EM_SetModify,0,0);
+End;
+
+Function WindowProc (Window:HWnd;AMessage,WParam,LParam:Longint): Longint;
+stdcall;
+export;
+
+Var
+    R: rect;
+    StatH: Word;
+    NrMenu : Longint;
+//  ps: paintstruct;
+Begin
+  WindowProc := 0;
+  Case AMessage Of
+{
+    wm_Paint:
+              Begin
+                GetClientRect(Window,@R);
+                BeginPaint(Window,@ps);
+                ...
+                EndPaint(Window,@ps);
+                Exit;
+              End;
+}
+    wm_Close:
+              Begin
+                AskSave;
+              End;
+    wm_Destroy:
+                Begin
+                  PostQuitMessage (0);
+                  Exit;
+                End;
+    wm_SetFocus:
+                 Begin
+                   SetFocus(HEdit);
+                 End;
+    wm_Size:
+             Begin
+               GetClientRect(HStatus,@R);
+               StatH := R.Bottom-R.Top;
+               GetClientRect(Window,@R);
+               MoveWindow (HEdit,0,0,R.Right,R.Bottom-StatH,False);
+               MoveWindow (HStatus,0,R.Bottom-StatH,R.Right,R.Bottom,False);
+             End;
+    wm_Command:
+                Begin
+                  NrMenu := LoWord(WParam);
+                  Case NrMenu Of
+                    101 : NewText;
+                    102 : LoadText;
+                    103 : SaveText;
+                    104 : PostMessage(Window,WM_Close,0,0);
+                    201 : SendMessage(HEdit,WM_Undo,0,0);
+                    202 : SendMessage(HEdit,WM_Cut,0,0);
+                    203 : SendMessage(HEdit,WM_Copy,0,0);
+                    204 : SendMessage(HEdit,WM_Paste,0,0);
+                    301 : MessageBox(Window,'Options','Not implemented',
+                                     MB_OK Or MB_IconInformation);
+                    401 : MessageBox(Window,'Help','Not implemented',
+                                     MB_OK Or MB_IconInformation);
+                  End;
+                End;
+  End;
+  WindowProc := DefWindowProc(Window,AMessage,WParam,LParam);
+End;
+
+Function WinRegister: Boolean;
+
+Var
+  WindowClass: WndClass;
+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;
+  WinRegister := 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;
+  CS_Ex = WS_EX_ClientEdge;
+  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(Status,@R);
+  StatH := R.Bottom-R.Top;
+  GetClientRect(ParentWindow,@R);
+  HEdit := CreateWindowEx (CS_Ex,'EDIT',EditText,CS_Start,0,0,
+                           R.Right-R.Left,R.Bottom-R.Top-StatH,ParentWindow,0,
+                           MainInstance,Nil);
+  If HEdit<>0 Then
+    Begin
+      ShowWindow(Hedit,SW_Show);
+      UpdateWindow(HEdit);
+    End;
+  EditCreate := HEdit;
+End;
+
+Function WinCreate: HWnd;
+
+Var hWindow: HWnd;
+    Menu: hMenu;
+    SubMenu: hMenu;
+Begin
+  hWindow := CreateWindow (AppName,'EditDemo',ws_OverlappedWindow,
+                           cw_UseDefault,cw_UseDefault,cw_UseDefault,
+                           cw_UseDefault,0,0,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,'&Undo'#8'Ctrl+Z');
+      AppendMenu(Submenu,MF_SEPARATOR,0,Nil);
+      AppendMenu(SubMenu,MF_String,202,'&Cut'#8'Ctrl+X');
+      AppendMenu(SubMenu,MF_String,203,'&Copy'#8'Ctrl+C');
+      AppendMenu(SubMenu,MF_STRING,204,'&Paste'#8'Ctrl+V');
+      AppendMenu(Menu,MF_POPUP,SubMenu,'&Edit');
+      SubMenu := CreateMenu;
+      AppendMenu(SubMenu,MF_String,301,'&Settings');
+      AppendMenu(Menu,MF_POPUP,SubMenu,'&Options');
+      AppendMenu(Menu,MF_STRING,401,'&Help');
+      SetMenu(hWindow,menu);
+      ShowWindow(hWindow,SW_Show);
+      UpdateWindow(hWindow);
+    End;
+  WinCreate := 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);
+          SetFocus(HEdit);
+          While GetMessage(@AMessage,0,0,0) Do
+          Begin
+            TranslateMessage(AMessage);
+            DispatchMessage(AMessage);
+          End;
+          Halt(AMessage.wParam);
+        End;
+    End;
+End.
+
+{
+  $Log$
+  Revision 1.1  2000-02-20 20:33:37  florian
+    * Initial revision
+
+}