{-----------------------------------------------------------------------------}
{                                                                             }
{           WEDL(tm) - Windows Enhanced Dialog Library                        }
{           Copyright (c) 1991-1992, Nemisoft, Inc.                           }
{           All Rights Reserved                                               }
{           Module:  DEMOTPW.PAS                                              }
{                                                                             }
{-----------------------------------------------------------------------------}

program DemoTPW;

{$S-}
{$R-}
{$N+}

{$R DEMOTPW.RES}

uses WinTypes, WinProcs, WEDL;

{-----------------------------------------------------------------------------}

type
    states_t = record
        state_code : PStr;
        zip_low    : Integer;
        zip_high   : Integer;
    end;

{-----------------------------------------------------------------------------}

const
    ClassName       = 'WEDLDemoTPW';
    idm_Dialog1     = 90;
    idm_Exit        = 91;
    idm_About       = 92;
    idd_SSN         = 100;
    idd_FirstName   = 101;
    idd_MidInit     = 102;
    idd_LastName    = 103;
    idd_Address     = 104;
    idd_City        = 105;
    idd_State       = 106;
    idd_ZipCode     = 107;
    idd_Phone       = 108;
    idd_HireDate    = 109;
    idd_Wage        = 110;
    idd_Insert      = 111;
    idh_SSN         = 100;
    idh_FirstName   = 101;
    idh_MidInit     = 102;
    idh_LastName    = 103;
    idh_Address     = 104;
    idh_City        = 105;
    idh_State       = 106;
    idh_ZipCode     = 107;
    idh_Phone       = 108;
    idh_HireDate    = 109;
    idh_Wage        = 110;
    BAD_STATE       = 1;
    BAD_ZIP         = 2;
    BAD_DATE        = 3;
    states          : array[0..54] of states_t = (
        ( state_code: 'AK'; zip_low: 995; zip_high: 999 ),
        ( state_code: 'AL'; zip_low: 350; zip_high: 369 ),
        ( state_code: 'AR'; zip_low: 716; zip_high: 729 ),
        ( state_code: 'AZ'; zip_low: 850; zip_high: 865 ),
        ( state_code: 'CA'; zip_low: 900; zip_high: 961 ),
        ( state_code: 'CO'; zip_low: 800; zip_high: 816 ),
        ( state_code: 'CT'; zip_low: 60;  zip_high: 69 ),
        ( state_code: 'DE'; zip_low: 197; zip_high: 199 ),
        ( state_code: 'FL'; zip_low: 320; zip_high: 349 ),
        ( state_code: 'GA'; zip_low: 300; zip_high: 319 ),
        ( state_code: 'HI'; zip_low: 967; zip_high: 968 ),
        ( state_code: 'IA'; zip_low: 500; zip_high: 528 ),
        ( state_code: 'ID'; zip_low: 832; zip_high: 847 ),
        ( state_code: 'IL'; zip_low: 600; zip_high: 629 ),
        ( state_code: 'IN'; zip_low: 460; zip_high: 479 ),
        ( state_code: 'KS'; zip_low: 641; zip_high: 679 ),
        ( state_code: 'KY'; zip_low: 400; zip_high: 427 ),
        ( state_code: 'LA'; zip_low: 700; zip_high: 714 ),
        ( state_code: 'MA'; zip_low: 10;  zip_high: 27 ),
        ( state_code: 'MD'; zip_low: 206; zip_high: 219 ),
        ( state_code: 'ME'; zip_low: 39;  zip_high: 49 ),
        ( state_code: 'MI'; zip_low: 480; zip_high: 499 ),
        ( state_code: 'MN'; zip_low: 550; zip_high: 567 ),
        ( state_code: 'MO'; zip_low: 630; zip_high: 658 ),
        ( state_code: 'MS'; zip_low: 386; zip_high: 397 ),
        ( state_code: 'MT'; zip_low: 590; zip_high: 599 ),
        ( state_code: 'NC'; zip_low: 270; zip_high: 289 ),
        ( state_code: 'ND'; zip_low: 580; zip_high: 588 ),
        ( state_code: 'NE'; zip_low: 680; zip_high: 693 ),
        ( state_code: 'NH'; zip_low: 30;  zip_high: 38 ),
        ( state_code: 'NJ'; zip_low: 70;  zip_high: 89 ),
        ( state_code: 'NM'; zip_low: 870; zip_high: 884 ),
        ( state_code: 'NV'; zip_low: 889; zip_high: 898 ),
        ( state_code: 'NY'; zip_low: 100; zip_high: 149 ),
        ( state_code: 'OH'; zip_low: 430; zip_high: 458 ),
        ( state_code: 'OK'; zip_low: 730; zip_high: 749 ),
        ( state_code: 'OR'; zip_low: 970; zip_high: 979 ),
        ( state_code: 'PA'; zip_low: 150; zip_high: 196 ),
        ( state_code: 'RI'; zip_low: 27;  zip_high: 29 ),
        ( state_code: 'SC'; zip_low: 290; zip_high: 299 ),
        ( state_code: 'SD'; zip_low: 570; zip_high: 577 ),
        ( state_code: 'TN'; zip_low: 370; zip_high: 385 ),
        ( state_code: 'TX'; zip_low: 750; zip_high: 885 ),
        ( state_code: 'UT'; zip_low: 840; zip_high: 847 ),
        ( state_code: 'VA'; zip_low: 220; zip_high: 246 ),
        ( state_code: 'VT'; zip_low: 50;  zip_high: 59 ),
        ( state_code: 'WA'; zip_low: 980; zip_high: 994 ),
        ( state_code: 'WI'; zip_low: 530; zip_high: 549 ),
        ( state_code: 'WV'; zip_low: 247; zip_high: 268 ),
        ( state_code: 'WY'; zip_low: 820; zip_high: 831 ),
        ( state_code: 'DC'; zip_low: 200; zip_high: 205 ),
        ( state_code: 'GU'; zip_low: 0;   zip_high: 999 ),
        ( state_code: 'PR'; zip_low: 0;   zip_high: 999 ),
        ( state_code: 'VI'; zip_low: 0;   zip_high: 999 ),
        ( state_code: nil ; zip_low: 0;   zip_high: 0   ) );

{-----------------------------------------------------------------------------}

var
    Form         : hform;
    perror_func  : PERRFUNC;
    pcheck_state, pcheck_zip_code, pcheck_date : PVALFUNC;
    tbuf : array[0..512] of Char;
    soc_sec_no : LongInt;
    first_name : array[0..15] of Char;
    mid_init   : array[0..1]  of Char;
    last_name  : array[0..20] of Char;
    address    : array[0..30] of Char;
    city       : array[0..15] of Char;
    state      : array[0..2]  of Char;
    zip_code   : array[0..9]  of Char;
    phone_num  : array[0..10] of Char;
    hire_date  : array[0..8]  of Char;
    wage       : Double;
    wage_str   : array[0..20] of Char;

{-----------------------------------------------------------------------------}

function AboutProc(Dialog: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
begin
    AboutProc := True;
    case Message of
        wm_InitDialog:
            Exit;
        wm_Command:
            if (WParam = id_Ok) or (WParam = id_Cancel) then
            begin
                EndDialog(Dialog, 1);
                Exit;
            end;
    end;
    AboutProc := False;
end;

{-----------------------------------------------------------------------------}

function ErrorHandler( Form: HFORM; Field: HFIELD; error_value, error_position,
                       error_event: Integer ): Bool; export;
var
    Dialog: HWnd;
begin
    ErrorHandler := True;
    Dialog := form_get_hdlg( Form );
    case error_value of
        BAD_DATE:
            begin
                MessageBox( Dialog, 'Date Is Invalid', nil, mb_Ok );
                Exit;
            end;
        BAD_STATE:
            begin
                MessageBox( Dialog, 'Invalid State Code', nil, mb_Ok );
                Exit;
            end;
        BAD_ZIP:
            begin
                if (error_position > 1) then
                    MessageBox( Dialog, 'Zip Code is incomplete', nil, mb_Ok )
                else
                    MessageBox( Dialog, 'Zip code is invalid for given State', nil, mb_Ok );
                Exit;
            end;
    end;
    ErrorHandler := False;          { error was not handled }
end;

{-----------------------------------------------------------------------------}

function DialogProc(Dialog: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
var
    P : array[0..11] of PChar;
begin
    DialogProc := True;
    case Message of
        wm_InitDialog:
            begin
                Form := form_begin( Dialog, FMF_NOSELECT or FMF_VKEYPRES or
                                    FMF_VLEAVFLD or FMF_UPDATE or FMF_OVERTYPE,
                                    perror_func );
                form_set_help( Form, 'demohelp.hlp', 0 );
                field_define( Form, idd_SSN, @soc_sec_no, FDT_LONG,
                              '<0..7>99"-"99"-"9(4)', FDF_NOTBLANK or
                              FDF_BLNKZERO or FDF_ZEROFILL or FDF_COMPLETE or
                              FDF_NUMERIC, nil, 0, idh_SSN );
                field_define( Form, idd_FirstName, @first_name, FDT_STRING,
                              'A(15)', FDF_PROPER, nil, 0, idh_FirstName );
                field_define( Form, idd_MidInit, @mid_init, FDT_STRING,
                              'A(1)"."',  FDF_UPPER, nil, 0, idh_MidInit );
                field_define( Form, idd_LastName, @last_name, FDT_STRING,
                              '<A..Z>A(19)', FDF_PROPER,
                              nil, 0, idh_LastName );
                field_define( Form, idd_Address, @address, FDT_STRING,
                              '?(30)', FDF_PROPER, nil, 0, idh_Address );
                field_define( Form, idd_City, @city, FDT_STRING,
                              '?(15)', FDF_PROPER, nil, 0, idh_City );
                field_define( Form, idd_State, @state, FDT_STRING,
                              'A(2)', FDF_COMPLETE or FDF_UPPER,
                              pcheck_state, BAD_STATE, idh_State );
                field_define( Form, idd_ZipCode, @zip_code, FDT_STRING,
                              '<0..9>(5)"-"9(4)', FDF_NONE,
                              pcheck_zip_code, BAD_ZIP, idh_ZipCode );
                field_define( Form, idd_Phone, @phone_num, FDT_STRING,
                              '"("999") "999"-"9999', FDF_COMPLETE,
                              nil, 0, idh_Phone );
                field_define( Form, idd_HireDate, @hire_date, FDT_STRING,
                              ' <01> 9 / <0123> 9 / <89> 9 ', FDF_COMPLETE or
                              FDF_PHYSICAL, pcheck_date, BAD_DATE,
                              idh_HireDate );
                field_define( Form, idd_Wage, @wage, FDT_DOUBLE,
                              '999999.99', FDF_NUMERIC or FDF_BLNKZERO or
                              FDF_BLNKNEZ, nil, 0, idh_Wage );
                keystat_define( Form, idd_Insert, KSM_INSERT, 'Insert: On',
                                'Insert: Off' );
                form_end( Form );
                Exit;
            end;
        wm_Command:
            begin
                if (WParam = id_Ok) then
                begin
                    form_ok( Form );
                    EndDialog(Dialog, 1);
                    P[0] := PChar( soc_sec_no );
                    P[1] := first_name;
                    P[2] := mid_init;
                    P[3] := last_name;
                    P[4] := address;
                    P[5] := city;
                    P[6] := state;
                    P[7] := zip_code;
                    P[8] := phone_num;
                    P[9] := hire_date;
                    Str( wage, wage_str );
                    P[10] := wage_str;
                    wvsprintf( tbuf, 'Soc Sec No.' + Chr(9) + '= %09ld' + Chr(10) +
                               'Name' + Chr(9) + Chr(9) + '= %s %s. %s' + Chr(10) +
                               'Address' + Chr(9) + Chr(9) + '= %s' + Chr(10) +
                               Chr(9) + Chr(9) + '= %s, %s %s' + Chr(10) +
                               'Phone No.' + Chr(9) + '= %s' + Chr(10) +
                               'Hire Date' + Chr(9) + '= %s' + Chr(10) +
                               'Wage/Salary' + Chr(9) + '= %s', P );
                    MessageBox( 0, tbuf, 'Field Contents', mb_Ok );
                    Exit;
                end;
                if (WParam = id_Cancel) then
                begin
                    form_cancel( Form );
                    EndDialog(Dialog, 1);
                    Exit;
                end;
            end;
        wm_Close:
            begin
                SendMessage( Dialog, wm_Command, id_Cancel, 0 );
                Exit;
            end;
    end;
    DialogProc := False;
end;

{-----------------------------------------------------------------------------}

Function CheckDate( Form: HFORM; Field: HFIELD; PBuf: PStr ): Integer; export;
var
    date : array[0..10] of Char;
    month, day, year, Code: Integer;
begin
    CheckDate := 0;
    if not str_is_blank( PBuf ) then
    begin

        { parse year, day, and month from buffer }
        lstrcpy( date, PBuf );
        Val( date + 4, year, Code );
        date[4] := Chr( 0 );
        Val( date + 2, day, Code );
        date[2] := Chr( 0 );
        Val( date, month, Code );

        { validate month }
        if month > 12 then
        begin
            CheckDate := 1;
            Exit;
        end;

        { validate day and month }
        if day < 1 then
        begin
            CheckDate := 3;
            Exit;
        end;
        case month of
            2:
                if year mod 4 <> 0 then
                begin
                    if day > 29 then
                    begin
                        CheckDate := 3;
                        Exit;
                    end;
                end
                else
                begin
                    if day > 28 then
                    begin
                        CheckDate := 3;
                        Exit;
                    end;
                end;
            1, 3, 5, 7, 8, 10, 12:
                if day > 31 then
                begin
                    CheckDate := 3;
                    Exit;
                end;
            4, 6, 9, 11:
                if day > 30 then
                begin
                    CheckDate := 3;
                    Exit;
                end;
            else
                begin
                    CheckDate := 1;
                    Exit;
                end;
        end;
    end;
end;

{-----------------------------------------------------------------------------}

Function CheckState( Form: HFORM; Field: HFIELD; PBuf: PStr ): Integer; export;
var
    i : Integer;
begin

    { allow state to be blank }
    if str_is_blank( PBuf ) then
    begin
        CheckState := 0;
        Exit;
    end;

    { do for all state codes in the table }
    i := 0;
    while states[i].state_code <> nil do
    begin
        if lstrcmp( states[i].state_code, PBuf ) = 0 then
        begin
            CheckState := 0;
            Exit;
        end;
        Inc( i );
    end;

    { not a legal 2-letter state code }
    CheckState := 1;
end;

{-----------------------------------------------------------------------------}

function CheckZipCode( Form: HFORM; Field: HFIELD; PBuf: PStr ): Integer; export;
var
    p : PStr;
    i, j, num_spaces : Integer;
    zip, zip_low, zip_high : LongInt;
begin

    { allow zip code to be blank }
    if str_is_blank( PBuf ) then
    begin
        CheckZipCode := 0;
        Exit;
    end;

    { count spaces in the extended portion of the 9-digit zip code }
    num_spaces := 0;
    p := PBuf + 5;
    while p^ <> Chr( 0 ) do
    begin
        if p^ = ' ' then Inc( num_spaces );
        Inc( p );
    end;

    { if zip code isn't exactly 5 or 9 digits, then there's an error }
    if ( num_spaces <> 0 ) and ( num_spaces <> 4 ) then
    begin
        CheckZipCode := 6;
        Exit;
    end;

    PBuf[5] := Chr( 0 );
    field_log_to_data( Field, PBuf, @zip, FDT_LONG );

    { find matching state }
    Field := field_get_from_ctrl_id( Form, IDD_STATE );
    field_get_text( Field, tbuf, False );
    i := 0;
    j := -1;
    while states[i].state_code <> nil do
    begin
        if lstrcmp( tbuf, states[i].state_code ) = 0 then j := i;
        Inc( i );
    end;
    if j <> -1 then i := j;
    if states[i].state_code = nil then
    begin
        CheckZipCode := 0;
        Exit;
    end;

    { test zip code }
    zip_low  := LongInt( states[i].zip_low )  * LongInt( 100 );
    zip_high := LongInt( states[i].zip_high ) * LongInt( 100 );
    if ( zip >= zip_low ) and ( zip <= zip_high ) then
        CheckZipCode := 0
    else
        CheckZipCode := 1;
end;

{-----------------------------------------------------------------------------}

function MainWndProc(Window: HWnd; Message, WParam: Word; LParam: Longint): Longint; export;
var
    pDialogProc, pAboutProc: TFarProc;
begin
    MainWndProc := 0;
    case Message of
        wm_Command:
            case WParam of
                idm_Dialog1:
                    begin
                        pDialogProc := MakeProcInstance(@DialogProc, HInstance);
                        pcheck_date := MakeProcInstance(@CheckDate, HInstance );
                        pcheck_state := MakeProcInstance(@CheckState, HInstance );
                        pcheck_zip_code := MakeProcInstance(@CheckZipCode, HInstance );
                        perror_func := MakeProcInstance(@ErrorHandler, HInstance);
                        DialogBox(HInstance, 'DIALOG_1', Window, pDialogProc);
                        FreeProcInstance(perror_func);
                        FreeProcInstance(pcheck_zip_code);
                        FreeProcInstance(pcheck_state);
                        FreeProcInstance(pcheck_date);
                        FreeProcInstance(pDialogProc);
                        Exit;
                    end;
                idm_Exit:
                    begin
                        SendMessage(Window, wm_Close, 0, 0);
                        Exit;
                    end;
                idm_About:
                    begin
                        pAboutProc := MakeProcInstance(@AboutProc, HInstance);
                        DialogBox(HInstance, 'AboutWEDL', Window, pAboutProc);
                        FreeProcInstance(pAboutProc);
                        Exit;
                    end;
            end;
        wm_Destroy:
            begin
                PostQuitMessage(0);
                Exit;
            end;
    end;
    MainWndProc := DefWindowProc(Window, Message, WParam, LParam);
end;

{-----------------------------------------------------------------------------}

procedure InitApplication;
const
    WindowClass: TWndClass = (
        style: 0;
        lpfnWndProc: @MainWndProc;
        cbClsExtra: 0;
        cbWndExtra: 0;
        hInstance: 0;
        hIcon: 0;
        hCursor: 0;
        hbrBackground: 0;
        lpszMenuName: 'MainMenu';
        lpszClassName: ClassName
    );
begin
    WindowClass.hInstance := HInstance;
    WindowClass.hIcon := LoadIcon(0, idi_Application);
    WindowClass.hCursor := LoadCursor(0, idc_Arrow);
    WindowClass.hbrBackground := GetStockObject(white_Brush);
    if not RegisterClass(WindowClass) then Halt(1);
end;

{-----------------------------------------------------------------------------}

procedure InitInstance;
var
    Window: HWnd;
begin
    Window := CreateWindow( ClassName, 'WEDL Demonstration Program',
                            ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
                            cw_UseDefault, cw_UseDefault, 0, 0, HInstance,
                            nil );
    if Window = 0 then Halt(1);
    ShowWindow(Window, CmdShow);
    UpdateWindow(Window);
end;

{-----------------------------------------------------------------------------}

procedure WinMain;
var
    Message: TMsg;
begin
    if HPrevInst = 0 then InitApplication;
    InitInstance;
    while GetMessage(Message, 0, 0, 0) do
    begin
        TranslateMessage(Message);
        DispatchMessage(Message);
    end;
    Halt(Message.wParam);
end;

begin
    WinMain;
end.