(***********************************************)
(*                                             *)
(* The Grapher (GUI Demo Application)          *)
(* Copyright (c) 1999 by TMT Development Corp. *)
(* Author: Vadim Bodrov, TMT Development Corp. *)
(*                                             *)
(* Targets:                                    *)
(*   WIN32 GUI application                     *)
(*                                             *)
(***********************************************)

program Grapher;

{$ifndef __WIN32__}
{$define INVALID_TARGET}
{$endif}
{$ifndef __GUI__}
{$define INVALID_TARGET}
{$endif}
{$ifdef INVALID_TARGET}
  This program must be compiled as Win32 GUI application only
{$endif}

uses Windows, Messages, CommDlg, CommCtrl, Strings, Math;

{$r grapher.res}

const
  MAIN_DIALOG         = 0101;
  ABOUT_DIALOG        = 0102;
  FORMULA_BOX         = 1000;
  SHOW_BUTTON         = 1001;
  CLOSE_BUTTON        = 1002;
  ABOUT_BUTTON        = 1004;
  MIN_BOX             = 1005;
  MAX_BOX             = 1006;
  STEP_BOX            = 1007;

var
  mainDlg, MainWindow:  THandle;
  Msg:                  TMsg;
  DC:                   hDC := 0;
  Brush:                hBrush := 0;
  Pen1, Pen2:           hPen := 0;
  Rect:                 TRect;

  Formula:              String := '';
  Steps:                Extended;
  MaxX, MinX:           Extended := 0;
  MaxY:                 Extended := 0;
  kX, kY:               Extended;
  step:                 Extended := 0;

  CANVAS_DX, CANVAS_DY: Extended;
  CANVAS_CX, CANVAS_CY: Extended;

procedure ErrorMessage(Text: PChar);
begin
  MessageBoxEx(0, Text, 'Error!', MB_ICONERROR or MB_TASKMODAL, LANG_NEUTRAL);
end;

function FunctionEvaluate(value: Extended; var ec: Longint): Extended;
var
  ValueS, TmpS: String;
  i: Longint;
  Invalid: Boolean := TRUE;
begin
  i := 1;
  TmpS := Formula;
  ValueS := FloatToStr(value);
  repeat
    if LoCase(TmpS[i]) = 'x' then
    begin
      Delete(TmpS, i, 1);
      Insert('(' + ValueS + ')', TmpS, i);
      i +:= Length(ValueS);
      Invalid := FALSE;
    end else
      i +:= 1;
  until i > Length(TmpS);
  if not Invalid then
    Evaluate(TmpS, Result, ec)
  else
    Result := 0;
end;

procedure GetMaxYRanges;
var
  x, y: Extended;
  ec: Longint;
  n: DWORD := 0;
  ScaleFlag: Boolean := TRUE;
  Delta: Extended := 0;
begin
  MaxY := 0;
  x := MinX;
  while x < MaxX + step do
  begin
    y := FunctionEvaluate(x, ec);
    if ec = NO_ERROR then
    begin
      n +:= 1;
      if Delta <> 0 then ScaleFlag := Abs(y) <= ((Delta / n) * 1000);
      if ScaleFlag and (Abs(y) > MaxY) then MaxY := Abs(y);
      Delta := Delta + MaxY;
    end;
    x +:= step;
  end;
end;

function CreateMainWindow(WndProc: Pointer): HWND;
var
  wc: TWndClass;
begin
  FillChar(wc,SizeOf(wc),0);
  wc.style         := CS_HREDRAW + CS_VREDRAW;
  wc.lpfnWndProc   := WndProc;
  wc.cbClsExtra    := 0;
  wc.cbWndExtra    := 0;
  wc.hInstance     := HInstance;
  wc.hIcon         := LoadIcon(hInstance, MAKEINTRESOURCE(101));
  wc.hCursor       := LoadCursor(THandle(nil), IDC_ARROW);
  wc.hbrBackGround := COLOR_WINDOW + 1;
  wc.lpszMenuName  := nil;
  wc.lpszClassName := 'GrapherDemo';

  if RegisterClass(wc) = 0 then Halt;

  Result := CreateWindow(wc.lpszClassName, 'Grapher (Drawing Area)',
    WS_SYSMENU or WS_CAPTION or WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, 0,
    CW_USEDEFAULT, 0, 0, 0, hInstance, nil);
end;

procedure InitCanvas;
var
  tr: TRect;
  TmpS: array [0..256] of Char;
  AbsMaxX: Extended;
begin
  GetClientRect(MainWindow, Rect);
  Rectangle(DC, 0, 0, Rect.Right, Rect.Bottom);
  CANVAS_DX := Rect.Right;
  CANVAS_CX := CANVAS_DX / 2;
  CANVAS_DY := Rect.Bottom;
  CANVAS_CY := CANVAS_DY / 2;

  if Abs(MaxX) > Abs(MinX) then
    AbsMaxX := Abs(MaxX)
  else
    AbsMaxX := Abs(MinX);

  MoveToEx(DC, Trunc(CANVAS_CX), 0, NIL); LineTo(DC, Trunc(CANVAS_CX), Trunc(CANVAS_DY));
  MoveToEx(DC, 0, Trunc(CANVAS_CY), NIL); LineTo(DC, Trunc(CANVAS_DX), Trunc(CANVAS_CY));

  tr.Top := Trunc(CANVAS_CY) + 2; tr.Left := Trunc(CANVAS_CX) - 10;
  tr.Right := Trunc(CANVAS_DX); tr.Bottom := Trunc(CANVAS_DY);
  DrawText(DC, '0', 1, tr, DT_LEFT);
  tr.Top := Trunc(CANVAS_CY) + 2; tr.Left := 0;
  tr.Right := Trunc(CANVAS_DX) - 2; tr.Bottom := Trunc(CANVAS_DY);
  DrawText(DC, StrPCopy(TmpS, FloatToStr(AbsMaxX)), Length(FloatToStr(AbsMaxX)), tr, DT_RIGHT);
  tr.Top := 2; tr.Left := 0;
  tr.Right := Trunc(CANVAS_CX) - 2; tr.Bottom := Trunc(CANVAS_DY);
  DrawText(DC, StrPCopy(TmpS, FloatToStr(MaxY)), Length(FloatToStr(MaxY)), tr, DT_RIGHT);

  if Pen2 = 0 then Pen2 := CreatePen(PS_SOLID, 2, $000000);
  SelectObject(DC, Pen2);
end;

procedure ShowGraphic;
var
  x, y: Extended;
  ec: Longint;
  isFirstPoint: Boolean := TRUE;
begin
  InitCanvas;
  if MaxY = 0 then exit;
  if Abs(MaxX) > Abs(MinX) then
    kX := CANVAS_DX / Abs(MaxX * 2)
  else
    kX := CANVAS_DX / Abs(MinX * 2);
  kY := CANVAS_CY / MaxY;
  x := MinX;
  while x < MaxX + step do
  begin
    y := FunctionEvaluate(x, ec);
    if ec = NO_ERROR then
    begin
      if isFirstPoint then
      begin
        MoveToEx(DC, Trunc(CANVAS_CX + x * kX), Trunc(CANVAS_CY - y * kY), NIL);
        isFirstPoint := FALSE;
      end else
        if (y * kY) > (CANVAS_CY) then
          isFirstPoint := TRUE
        else
        if (y * kY) < (-CANVAS_CY) then
          isFirstPoint := TRUE
        else
          LineTo(DC, Trunc(CANVAS_CX + x * kX), Trunc(CANVAS_CY - y * kY));
    end else
      isFirstPoint := TRUE;
    x := x + step;
  end;
end;

function AboutDlgProc conv arg_stdcall (Dialog: HWND; Mess: UINT; WParam: WParam; LParam: LParam): LongInt;
begin
  if (Mess = WM_CLOSE) or ((Mess = WM_COMMAND) and
     (LoWord(WParam) = IDOK)) then
  begin
    EndDialog(Dialog, 0);
    Result := 1;
  end else
    Result := 0;
end;

function MyWndProc conv arg_stdcall (Window: HWND; Mess: DWord; WParam: DWord; LParam: LongInt): LongInt;
begin
  Result := 0;
  case Mess of
  WM_ERASEBKGND:
    begin
      if DC <> 0 then ShowGraphic;
      Result := 1;
    end;
  WM_CLOSE:
    Result := DefWindowProc(Window, Mess, WParam, LParam);
  WM_DESTROY:
    PostQuitMessage(0);
  else
    Result := DefWindowProc(Window, Mess, WParam, LParam);
  end;
end;

function MainDlgProc conv arg_stdcall (Dialog: HWND; Mess: UINT; WParam: WParam; LParam: LParam): LongInt;
var
  ScrollPos: DWord;
  TmpC: array[0..255] of char;
  ec: Longint;
  S: String;
begin
 Result := 0;
 case Mess of
   WM_INITDIALOG:
     begin
       SetFocus(GetDlgItem(Dialog, SHOW_BUTTON));
       TmpC := '0' + #0;
       SendDlgItemMessage(Dialog, MIN_BOX, WM_SETTEXT, 255, DWORD(@TmpC));
       SendDlgItemMessage(Dialog, MAX_BOX, WM_SETTEXT, 255, DWORD(@TmpC));
       TmpC := 'x' + #0;
       SendDlgItemMessage(Dialog, FORMULA_BOX, WM_SETTEXT, 255, DWORD(@TmpC));
       TmpC := '100' + #0;
       SendDlgItemMessage(Dialog, STEP_BOX, WM_SETTEXT, 255, DWORD(@TmpC));
       Result := 0;
     end;

   WM_CLOSE:
     begin
       DeleteObject(Brush);
       DeleteObject(Pen1);
       DeleteObject(Pen2);
       ReleaseDC(MainWindow, DC);
       DC := 0;
       DestroyWindow(Dialog);
     end;

   WM_COMMAND:
     begin
       case LoWord(WParam) of
         ABOUT_BUTTON:
           DialogBoxParam(HInstance, MAKEINTRESOURCE(102), maindlg, @AboutDlgProc, 0);
         CLOSE_BUTTON:
           DestroyWindow(Dialog);
         SHOW_BUTTON:
         begin
           SendDlgItemMessage(Dialog, FORMULA_BOX, WM_GETTEXT, 255, DWORD(@TmpC));
           Formula := StrPas(TmpC);
           if Formula = '' then
           begin
             ErrorMessage('Formula is not specified');
             exit;
           end;
           SendDlgItemMessage(Dialog, MIN_BOX, WM_GETTEXT, 255, DWORD(@TmpC));
           Val(StrPas(TmpC), MinX, ec);
           if ec <> 0 then
           begin
             ErrorMessage('Invalid Min range');
             exit;
           end;
           SendDlgItemMessage(Dialog, MAX_BOX, WM_GETTEXT, 255, DWORD(@TmpC));
           Val(StrPas(TmpC), MaxX, ec);
           if ec <> 0 then
           begin
             ErrorMessage('Invalid Max range');
             exit;
           end;
           if MinX >= MaxX then
           begin
             ErrorMessage('Max must be greater than Min');
             exit;
           end;
           SendDlgItemMessage(Dialog, STEP_BOX, WM_GETTEXT, 255, DWORD(@TmpC));
           Val(StrPas(TmpC), Steps, ec);
           if (ec <> 0) or (Steps < 20) then
           begin
             ErrorMessage('Invalid Steps value');
             exit;
           end;
           step := (MaxX - MinX) / STEPS;
           GetMaxYRanges;
           if MaxY = 0 then begin
             ErrorMessage('Invalid formula');
             exit;
           end;
           ShowGraphic;
         end;
       end;
     end;

   WM_DESTROY:
     PostQuitMessage(0);

  else
    Result := 0;
  end;
end;

begin
  InitCommonControls;
  MainWindow := CreateMainWindow(@MyWndProc);
  ShowWindow(MainWindow, SW_SHOW);
  mainDlg := CreateDialog(HInstance, MAKEINTRESOURCE(MAIN_DIALOG), 0, @MainDlgProc);
  ShowWindow(mainDlg, SW_SHOW);
  SendMessage(mainDlg, WM_SETICON, ICON_SMALL, LoadIcon(hInstance, MAKEINTRESOURCE(101)));

  DC := GetDC(MainWindow);
  Brush := CreateSolidBrush($FFFFFF);
  SelectObject(DC, Brush);
  Pen1 := CreatePen(PS_SOLID, 0, $000000);
  SelectObject(DC, Pen1);
  InitCanvas;

  while GetMessage(Msg, 0, 0, 0) do begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end.