home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 February / PCWorld_2003-02_cd.bin / Software / Topware / devpascal / examples / FileEditor / Main.pp < prev    next >
Encoding:
Text File  |  2000-09-12  |  10.8 KB  |  385 lines
  1. {
  2.   $Id: edit.pp,v 1.2 2000/02/27 21:07:58 florian Exp $
  3.   Copyright (c) 1999 by Michael van Canneyt and Goran Andersson
  4.  
  5.   Win32 editor example.
  6.   Modified by Colin Laplace on 12/09/2000
  7. }
  8.  
  9. program FileEditor;
  10.  
  11. {$APPTYPE GUI}
  12.  
  13. Uses
  14.   Strings,Windows;
  15.  
  16. Const
  17.   AppName = 'File Editor';
  18.  
  19. Type
  20.   TFileName = Array[0..Max_Path] Of Char;
  21.  
  22. Var
  23.   AMessage              : Msg;
  24.   HWindow,HStatus,HEdit : HWnd;
  25.   TheLogFont            : TLogFont;
  26.   TheColor              : DWORD;
  27.   FileName              : TFileName;
  28.  
  29. {********************************************************************}
  30.  
  31. Procedure SetStatusText(Num : Integer; Const Text : string);
  32. var
  33.   StatText : array[0..255] of Char;
  34. begin
  35.   if Num = 0 then
  36.     StatText[0] := ' '  // Add space to text in first item
  37.   else
  38.     StatText[0] := #9;  // Center the rest
  39.   StrPCopy(@StatText[1],Text);
  40.   SendMessage(HStatus,SB_SETTEXT,Num,LongInt(@StatText));
  41. end;
  42.  
  43. {********************************************************************}
  44.  
  45. Function SelectFile(Var FName:TFileName; Open:Boolean): Boolean;
  46. Const
  47.   Filter : PChar = 'Text files (*.txt)'#0'*.txt'#0+
  48.                    'All files (*.*)'#0'*.*'#0#0;
  49.   Ext    : PChar = 'txt';
  50. Var
  51.   NameRec : OpenFileName;
  52. Begin
  53.   FillChar(NameRec,SizeOf(NameRec),0);
  54.   FName[0] := #0;
  55.   With NameRec Do
  56.     Begin
  57.       LStructSize := SizeOf(NameRec);
  58.       HWndOwner   := HWindow;
  59.       LpStrFilter := Filter;
  60.       LpStrFile   := @FName;
  61.       NMaxFile    := Max_Path;
  62.       Flags       := OFN_Explorer Or OFN_HideReadOnly;
  63.       If Open Then
  64.         Begin
  65.           Flags := Flags Or OFN_FileMustExist;
  66.         End;
  67.       LpStrDefExt := Ext;
  68.     End;
  69.   If Open Then
  70.       SelectFile := GetOpenFileName(@NameRec)
  71.   Else
  72.       SelectFile := GetSaveFileName(@NameRec);
  73. End;
  74.  
  75. {********************************************************************}
  76.  
  77. Procedure SaveText;
  78. Var
  79.   Len   : Longint;
  80.   P     : PChar;
  81.   F     : File;
  82.   FName : TFileName;
  83. Begin
  84.   If SelectFile(FName,False) Then
  85.     Begin
  86.       Assign(F,@FName);
  87.       Rewrite(F,1);
  88.       Len := GetWindowTextLength(HEdit);
  89.       GetMem(P,Len+1);
  90.       P[Len] := #0;
  91.       If Len>0 Then
  92.         Begin
  93.           GetWindowText(HEdit,P,Len+1);
  94.           BlockWrite(F,P^,Len);
  95.         End;
  96.       Close(F);
  97.       FreeMem(P,Len+1);
  98.       StrCopy(FileName,FName);
  99.       SetStatusText(0,StrPas(FileName));
  100.       SetStatusText(1,'');
  101.       SendMessage(HEdit,EM_SetModify,0,0);
  102.     End;
  103. End;
  104.  
  105. {********************************************************************}
  106.  
  107. Procedure AskSave;
  108. Const
  109.   BoxType = MB_IconQuestion Or MB_YesNo;
  110. Begin
  111.   If SendMessage(HEdit,EM_GetModify,0,0)<>0 Then
  112.     Begin
  113.       If MessageBox(HWindow,'Save text?','Edited',BoxType)=IdYes Then
  114.         Begin
  115.           SaveText;
  116.         End;
  117.     End;
  118. End;
  119.  
  120. {********************************************************************}
  121.  
  122. Procedure LoadText;
  123. Var
  124.   F     : File;
  125.   Len   : LongInt;
  126.   P     : PChar;
  127. Begin
  128.   AskSave;
  129.   If SelectFile(FileName,True) Then
  130.     Begin
  131.       Assign(F,@FileName);
  132.       Reset(F,1);
  133.       Len := FileSize(F);
  134.       GetMem(P,Len+1);
  135.       P[Len] := #0;
  136.       If Len>0 Then BlockRead(F,P^,Len);
  137.       Close(F);
  138.       SetWindowText(HEdit,P);
  139.       SendMessage(HEdit,EM_SetModify,0,0);
  140.       FreeMem(P,Len+1);
  141.       SetStatusText(0,StrPas(FileName));
  142.       SetStatusText(1,'');
  143.     End;
  144. End;
  145.  
  146. {********************************************************************}
  147.  
  148. Procedure NewText;
  149. Const
  150.   Empty : PChar = '';
  151. Begin
  152.   AskSave;
  153.   FileName := 'Unsaved';
  154.   SetStatusText(0,StrPas(FileName));
  155.   SendMessage(HEdit,WM_SetText,1,LongInt(Empty));
  156.   SendMessage(HEdit,EM_SetModify,0,0);
  157. End;
  158.  
  159. {********************************************************************}
  160.  
  161. Function WindowProc (Window:HWnd;AMessage,WParam,LParam:Longint): Longint;
  162. stdcall; export;
  163. Var
  164.   R        : rect;
  165.   StatH    : Word;
  166.   NrMenu   : Longint;
  167.   NotiCode : LongInt;
  168. Begin
  169.   WindowProc := 0;
  170.   Case AMessage Of
  171.     wm_Close:
  172.       Begin
  173.         AskSave;
  174.       End;
  175.     wm_Destroy:
  176.       Begin
  177.         PostQuitMessage (0);
  178.         Exit;
  179.       End;
  180.     wm_SetFocus:
  181.       Begin
  182.         SetFocus(HEdit);
  183.       End;
  184.     WM_EraseBkgnd:
  185.       Begin
  186.         Exit(1);
  187.       End;
  188.     wm_Size:
  189.       Begin
  190.         GetClientRect(HStatus,@R);
  191.         StatH := R.Bottom-R.Top;
  192.         GetClientRect(Window,@R);
  193.         MoveWindow (HEdit,0,0,R.Right,R.Bottom-StatH,False);
  194.         MoveWindow (HStatus,0,R.Bottom-StatH,R.Right,R.Bottom,False);
  195.       End;
  196.     wm_Command:
  197.       Begin
  198.         NotiCode := HiWord(WParam);
  199.         Case NotiCode of
  200.           en_Change    : //Editor has changed
  201.             Begin
  202.               If SendMessage(HEdit,EM_GetModify,0,0)<>0 then
  203.                 SetStatusText(1,'Modified')
  204.               Else
  205.                 SetStatusText(1,'');
  206.             End;
  207.           Else
  208.             Begin //Menu item
  209.               NrMenu := LoWord(WParam);
  210.               Case NrMenu Of
  211.                 101 : NewText;
  212.                 102 : LoadText;
  213.                 103 : SaveText;
  214.                 104 : PostMessage(Window,WM_Close,0,0);
  215.                 201 : SendMessage(HEdit,WM_Undo,0,0);
  216.                 202 : SendMessage(HEdit,WM_Cut,0,0);
  217.                 203 : SendMessage(HEdit,WM_Copy,0,0);
  218.                 204 : SendMessage(HEdit,WM_Paste,0,0);
  219.                 401 : MessageBox(Window,'Help','Not implemented',
  220.                                  MB_OK Or MB_IconInformation);
  221.               End;
  222.             End;
  223.         End;
  224.       End;
  225.     wm_CtlColorEdit :
  226.       Begin
  227.         SetTextColor(WParam,TheColor);
  228.         Exit(GetSysColorBrush(COLOR_WINDOW));
  229.       End;
  230.   End;
  231.   WindowProc := DefWindowProc(Window,AMessage,WParam,LParam);
  232. End;
  233.  
  234. {********************************************************************}
  235.  
  236. Function WinRegister: Boolean;
  237. Var
  238.   WindowClass : WndClass;
  239. Begin
  240.   With WindowClass Do
  241.     Begin
  242.       Style         := cs_hRedraw Or cs_vRedraw;
  243.       lpfnWndProc   := WndProc(@WindowProc);
  244.       cbClsExtra    := 0;
  245.       cbWndExtra    := 0;
  246.       hInstance     := system.MainInstance;
  247.       hIcon         := LoadIcon (0,idi_Application);
  248.       hCursor       := LoadCursor (0,idc_Arrow);
  249.       hbrBackground := GetStockObject(GRAY_BRUSH);
  250.       lpszMenuName  := Nil;
  251.       lpszClassName := AppName;
  252.     End;
  253.   WinRegister := RegisterClass (WindowClass)<>0;
  254. End;
  255.  
  256. {********************************************************************}
  257.  
  258. Function EditCreate(ParentWindow,Status:HWnd): HWnd;
  259. Const
  260.   CS_Start = WS_Child or WS_HScroll or WS_VScroll or ES_MultiLine or ES_Left;
  261.   CS_Ex    = WS_EX_ClientEdge;
  262.   EdiTText : PChar = '';
  263. Var
  264.   HEdit : HWND;
  265.   R     : TRect;
  266.   StatH : Word;
  267. Begin
  268.   GetClientRect(Status,@R);
  269.   StatH := R.Bottom-R.Top;
  270.   GetClientRect(ParentWindow,@R);
  271.   HEdit := CreateWindowEx (CS_Ex,'EDIT',EditText,CS_Start,0,0,
  272.                            R.Right-R.Left,R.Bottom-R.Top-StatH,ParentWindow,0,
  273.                            MainInstance,Nil);
  274.   If HEdit<>0 Then
  275.     Begin
  276.       //Set Courier new as default font
  277.       with TheLogFont do
  278.         begin
  279.           lfHeight         := 0;                // Default logical height of font
  280.           lfWidth          := 0;                // Default logical average character width
  281.           lfEscapement     := 0;                // angle of escapement
  282.           lfOrientation    := 0;                // base-line orientation angle
  283.           lfWeight         := FW_NORMAL;        // font weight
  284.           lfItalic         := 0;                // italic attribute flag
  285.           lfUnderline      := 0;                // underline attribute flag
  286.           lfStrikeOut      := 0;                // strikeout attribute flag
  287.           lfCharSet        := DEFAULT_CHARSET;  // character set identifier
  288.           lfOutPrecision   := OUT_DEFAULT_PRECIS;  // output precision
  289.           lfClipPrecision  := CLIP_DEFAULT_PRECIS; // clipping precision
  290.           lfQuality        := DEFAULT_QUALITY;     // output quality
  291.           lfPitchAndFamily := DEFAULT_PITCH;    // pitch and family
  292.           Strcopy(lfFaceName,'Courier New');    // pointer to typeface name string
  293.         end;
  294.       TheColor := GetSysColor(COLOR_WINDOWTEXT);
  295.       ShowWindow(Hedit,SW_Show);
  296.       UpdateWindow(HEdit);
  297.     End;
  298.   EditCreate := HEdit;
  299. End;
  300.  
  301. {********************************************************************}
  302.  
  303. Function WinCreate: HWnd;
  304.  
  305. Var hWindow : HWnd;
  306.     Menu    : hMenu;
  307.     SubMenu : hMenu;
  308. Begin
  309.   hWindow := CreateWindow (AppName,'File Editor',ws_OverlappedWindow,
  310.                            cw_UseDefault,cw_UseDefault,cw_UseDefault,
  311.                            cw_UseDefault,0,0,MainInstance,Nil);
  312.   If hWindow<>0 Then
  313.     Begin
  314.       Menu := CreateMenu;
  315.       SubMenu := CreateMenu;
  316.       AppendMenu(Submenu,MF_STRING,101,'&New...');
  317.       AppendMenu(Submenu,MF_STRING,102,'&Open...');
  318.       AppendMenu(Submenu,MF_STRING,103,'&Save...');
  319.       AppendMenu(Submenu,MF_SEPARATOR,0,Nil);
  320.       AppendMenu(SubMenu,MF_String,104,'E&xit');
  321.       AppendMenu(Menu,MF_POPUP,SubMenu,'&File');
  322.       SubMenu := CreateMenu;
  323.       AppendMenu(SubMenu,MF_String,201,'&Undo'#8'Ctrl+Z');
  324.       AppendMenu(Submenu,MF_SEPARATOR,0,Nil);
  325.       AppendMenu(SubMenu,MF_String,202,'&Cut'#8'Ctrl+X');
  326.       AppendMenu(SubMenu,MF_String,203,'&Copy'#8'Ctrl+C');
  327.       AppendMenu(SubMenu,MF_STRING,204,'&Paste'#8'Ctrl+V');
  328.       AppendMenu(Menu,MF_POPUP,SubMenu,'&Edit');
  329.       SubMenu := CreateMenu;
  330.       AppendMenu(Menu,MF_STRING,401,'&Help');
  331.       SetMenu(hWindow,menu);
  332.       ShowWindow(hWindow,SW_Show);
  333.       UpdateWindow(hWindow);
  334.     End;
  335.   WinCreate := hWindow;
  336. End;
  337.  
  338. {********************************************************************}
  339.  
  340. Function StatusCreate (parent:hwnd): HWnd;
  341. var
  342.   AWnd   : HWnd;
  343.   Edges  : array[1..2] of LongInt;
  344. Begin
  345.   FileName := 'Unsaved';
  346.   AWnd := CreateStatusWindow(WS_CHILD or WS_VISIBLE,FileName,Parent,$7712);
  347.   // Create items:
  348.   if AWnd <> 0 then
  349.     begin
  350.       Edges[1] := 400;
  351.       Edges[2] := 500;
  352.       SendMessage(AWnd,SB_SETPARTS,2,LongInt(@Edges));
  353.     end;
  354.   StatusCreate := AWnd;
  355. End;
  356.  
  357. {********************************************************************}
  358.  
  359. Begin
  360.   If Not WinRegister Then
  361.     Begin
  362.       MessageBox (0,'Register failed',Nil, mb_Ok);
  363.     End
  364.   Else
  365.     Begin
  366.       hWindow := WinCreate;
  367.       If longint(hWindow)=0 Then
  368.         Begin
  369.           MessageBox (0,'WinCreate failed',Nil,MB_OK);
  370.         End
  371.       Else
  372.         Begin
  373.           HStatus := statuscreate(hwindow);
  374.           HEdit := EditCreate(HWindow,HStatus);
  375.           SetFocus(HEdit);
  376.           While GetMessage(@AMessage,0,0,0) Do
  377.             Begin
  378.               TranslateMessage(AMessage);
  379.               DispatchMessage(AMessage);
  380.             End;
  381.           Halt(AMessage.wParam);
  382.         End;
  383.     End;
  384. End.
  385.