Metropoli BBS
VIEWER: filedlg.pas MODE: TEXT (CP437)
{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples. Version 1.10            █}
{█        File Dialog Example                            █}
{█        The Art Of OS/2, Chapter 26, p494-498          █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (c) 1992-1996 by Kathleen Panov        █}
{█      VP/2 Version Copyright (C) 1996 fPrint UK Ltd    █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

Program FileDlg;

{$PMTYPE PM}

{$R *.RES}
{$D File dialog example - Copyright (c) 1992-1995 by Kathleen Panov.}

Uses
  Use32, Os2Def, Os2PmApi, Strings;

{$IFDEF VPDEMO}
  {&Dynamic VP11Demo.Lib}
{$ENDIF}

Const
  RES_CLIENT  = 256;
  IDM_SUB1    = 512;
  IDM_NEW     = 513;
  IDM_OPEN    = 514;
  IDM_CLOSE   = 515;
  IDM_EXIT    = 516;
  CLS_CLIENT  = 'MyClass';

Procedure DisplayError( pszText: PChar );
begin
  {************************************************************}
  {* small function to display error string                   *}
  {************************************************************}

  WinAlarm( HWND_DESKTOP,
            WA_ERROR );
  WinMessageBox( HWND_DESKTOP,
                 HWND_DESKTOP,
                 pszText,
                 'Error!',
                 0,
                 MB_OK OR MB_ERROR );
end;

Function FindFile( hwndClient : HWnd; pchFile : PChar ) : Bool;
Var
  fdFileDlg : Os2PmApi.FileDlg;

begin
  Fillchar( fdFileDlg, sizeof(fdFileDlg), 0);

  fdFileDlg.cbSize := sizeof(Os2PmApi.FileDlg);
  fdFileDlg.fl := FDS_CENTER OR FDS_PRELOAD_VOLINFO OR FDS_OPEN_DIALOG;

  if (WinFileDlg( HWND_DESKTOP,
                  hwndClient,
                  fdFileDlg ) <> DID_OK) then
    begin
      DisplayError('WinFileDlg failed');
      FindFile := False;
    end
  else
    begin
      strCopy( pchFile, fdFileDlg.szFullFile);
      FindFile := TRUE;
    end;
end; { FindFile }

Function ClientWndProc ( hwndClient : HWND ;
                         ulMsg      : ULONG;
                         mpParm1    : MPARAM;
                         mpParm2    : MPARAM ) : mResult; cdecl;

Var
  pchFile     : pChar;
  hpsPaint    : HPS;
  rclInvalid  : RectL;
  achText     : Array[0..CCHMAXPATH] of Char;

begin
  ClientWndProc := ord( False );

  Case ulMsg of
    WM_CREATE :
      begin
        GetMem( pchFile, CCHMAXPATH );
        if pchFile = nil then
          begin
            DisplayError('No memory could be allocated');
            ClientWndProc := ord(TRUE);
          end
        else
          WinSetWindowPtr( hwndClient,
                           QWL_USER,
                           pchFile );
      end; { WM_CREATE }

    WM_DESTROY :
      begin
        pchFile := WinQueryWindowPtr(hwndClient, 0);
        if pchFile <> nil then
          FreeMem( pchFile, CCHMAXPATH );
      end;

    WM_PAINT :
      begin
        hpsPaint := WinBeginPaint( hwndClient,
                                   NULLHANDLE,
                                   @rclInvalid );

        WinFillRect( hpsPaint,
                     rclInvalid,
                     SYSCLR_WINDOW );
        pchFile := WinQueryWindowPtr(hwndClient, 0);

        if pchFile[0] <> #0 then
          begin
            WinQueryWindowRect( hwndClient, rclInvalid );
            strCopy( achText, 'You have selected file ' );
            strCat( achText, pchFile );
            WinDrawText(hpsPaint,
                        -1,
                        achText,
                        rclInvalid,
                        0,
                        0,
                        DT_CENTER OR DT_VCENTER OR DT_TEXTATTRS);
          end;
        WinEndPaint(hpsPaint);
      end; { WM_PAINT }

    WM_COMMAND :
      Case SHORT1FROMMP(mpParm1) of
        IDM_OPEN :
          begin
            pchFile := WinQueryWindowPtr(hwndClient, 0);

            if pchFile <> nil then
              FindFile( hwndClient, pchFile );

            WinInvalidateRect( hwndClient,
                               nil,
                               TRUE);
          end;

        IDM_EXIT :
          WinPostMsg(hwndClient, WM_QUIT, 0, 0);

        else
          ClientWndProc := WinDefWindowProc( hwndClient,
                                             ulMsg,
                                             mpParm1,
                                             mpParm2);
      end; { WM_COMMAND }

   else
     ClientWndProc := WinDefWindowProc( hwndClient,
                                        ulMsg,
                                        mpParm1,
                                        mpParm2);
  end; { Case ulMsg }
end; { ClientWndProc }

Var
  habAnchor   : HAB;
  hmqQueue    : HMQ;
  ulFlags     : ULONG;
  lHeight     : Long;
  lWidth      : Long;
  hwndFrame   : HWND;
  hwndClient  : HWnd;
  bLoop       : BOOL;
  qmMsg       : QMSG;

begin
  habAnchor := WinInitialize(0);
  hmqQueue := WinCreateMsgQueue(habAnchor,
                               0);

  WinRegisterClass( habAnchor,
                    CLS_CLIENT,
                    ClientWndProc,
                    CS_SIZEREDRAW OR CS_SYNCPAINT,
                    sizeof(Pointer) );

  ulFlags := FCF_TITLEBAR OR FCF_SYSMENU OR FCF_SIZEBORDER OR FCF_MENU OR
     FCF_MINMAX;

  {************************************************************}
  {* create frame and client window                           *}
  {************************************************************}

  hwndFrame := WinCreateStdWindow(HWND_DESKTOP,
                                  0,
                                  ulFlags,
                                  CLS_CLIENT,
                                  'File Dialog Example',
                                  0,
                                  NULLHANDLE,
                                  RES_CLIENT,
                                  @hwndClient);

  {************************************************************}
  {* get screen height and width                              *}
  {************************************************************}

  lWidth := WinQuerySysValue(HWND_DESKTOP,  SV_CXSCREEN);

  lHeight := WinQuerySysValue(HWND_DESKTOP, SV_CYSCREEN);

  {************************************************************}
  {* set size and position of frame window                    *}
  {************************************************************}

  if hwndFrame <> 0 then
    begin
      WinSetWindowPos(hwndFrame,
                      NULLHANDLE,
                      lWidth div 8,
                      lHeight div 8,
                      lWidth div 8*6,
                      lHeight div 8*6,
                      SWP_SIZE OR SWP_MOVE OR SWP_ACTIVATE OR SWP_SHOW);

      bLoop := WinGetMsg(habAnchor,
                         qmMsg,
                         NULLHANDLE,
                         0,
                         0);
      while bLoop do
        begin
          WinDispatchMsg( habAnchor,
                          qmMsg);
          bLoop := WinGetMsg( habAnchor,
                              qmMsg,
                              NULLHANDLE,
                              0,
                              0);
        end;
      WinDestroyWindow(hwndFrame);
    end;
  WinDestroyMsgQueue(hmqQueue);
  WinTerminate(habAnchor);
end.



[ RETURN TO DIRECTORY ]