unit SerialF;
//*******************************************************
// Example program demonstrating command object
// serialization and serialization.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, StdCtrls,
  Serials, SerDraw, SerRect, SerEll, SerLine;

type
  TSerialForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    mnuAbout: TMenuItem;
    Edit1: TMenuItem;
    mnuUndo: TMenuItem;
    mnuRedo: TMenuItem;
    ShapeGroup: TRadioGroup;
    ColorGroup: TRadioGroup;
    FillStyleGroup: TRadioGroup;
    DrawingArea: TImage;
    mnuOpen: TMenuItem;
    mnuNew: TMenuItem;
    mnuSave: TMenuItem;
    mnuSaveAs: TMenuItem;
    N1: TMenuItem;
    FileOpenDialog: TOpenDialog;
    FileSaveDialog: TSaveDialog;
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure DrawingAreaMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DrawingAreaMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DrawingAreaMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CreateCommandObject;
    procedure DrawCommands;
    procedure FormCreate(Sender: TObject);
    procedure DrawShape(x1, y1, x2, y2 : Integer);
    procedure mnuUndoClick(Sender: TObject);
    procedure mnuRedoClick(Sender: TObject);
    function DataUnsafe : Boolean;
    procedure SaveData;
    procedure SaveDataAs;
    procedure SaveTheData;
    procedure LoadTheData;
    procedure mnuNewClick(Sender: TObject);
    procedure MakeNew;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure mnuSaveClick(Sender: TObject);
    procedure mnuSaveAsClick(Sender: TObject);
    procedure mnuOpenClick(Sender: TObject);
    procedure SetDataModified(value, force : Boolean);

  private
    { Private declarations }
    StartX, StartY : Integer;
    CurX, CurY     : Integer;
    NewCmd         : TDrawingCommand;
    Commands       : array [1..1000] of TDrawingCommand;
    NumCommands    : Integer; // The number allocated.
    LastCommand    : Integer; // Index of last command used.
    DataModified   : Boolean; // Has the data been modified?
    FileName       : String;  // Name of current file.

  public
    { Public declarations }
  end;

var
  SerialForm: TSerialForm;

implementation

{$R *.DFM}

procedure TSerialForm.mnuExitClick(Sender: TObject);
begin
    Close;
end;

procedure TSerialForm.mnuAboutClick(Sender: TObject);
begin
    MessageDlg(
        'This program uses serializable command objects to save and restore shapes. Click and drag to draw shapes.'
        , mtInformation, [mbOK], 0);
end;

// Start a rubber band operation to draw something.
procedure TSerialForm.DrawingAreaMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    StartX := X;
    StartY := Y;
    CurX := X;
    CurY := Y;
    CreateCommandObject;
    DrawingArea.Canvas.Brush.Style := bsClear;
    DrawingArea.Canvas.Pen.Mode := pmNot;
end;

// Continue a rubber band operation.
procedure TSerialForm.DrawingAreaMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
    if (NewCmd = nil) then exit;

    DrawShape(StartX, StartY, CurX, CurY);
    CurX := X;
    CurY := Y;
    DrawShape(StartX, StartY, CurX, CurY);
end;

// Finsh a rubber band operation.
procedure TSerialForm.DrawingAreaMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if (NewCmd = nil) then exit;

    DrawShape(StartX, StartY, CurX, CurY);
    DrawingArea.Canvas.Pen.Mode := pmCopy;

    CurX := X;
    CurY := Y;

    // If (StartX, StartY) = (CurX, CurY), the command
    // occupies no area.
    if ((StartX = CurX) and (StartY = CurY)) then
    begin
        // Destroy the new command object.
        NumCommands := NumCommands - 1;
        LastCommand := NumCommands;
        mnuUndo.Enabled := (NumCommands > 0);
        mnuRedo.Enabled := False;
        NewCmd.Free;
    end else begin
        // Save the command object's position.
        NewCmd.SetPosition(StartX, StartY, CurX, CurY);

        // Draw the new command.
        NewCmd.Draw(DrawingArea.Canvas, True);

        // The data has changed.
        SetDataModified(True, False);
    end;
    NewCmd := nil;
end;

// Create an appropriate command object.
procedure TSerialForm.CreateCommandObject;
var
    color : TColor;
    style : TBrushStyle;
begin
    case (ShapeGroup.ItemIndex) of
        0: NewCmd := TRectangleCmd.Create;
        1: NewCmd := TEllipseCmd.Create;
        2: NewCmd := TLineCmd.Create;
    end;

    case (ColorGroup.ItemIndex) of
        0: color := clRed;
        1: color := clBlack;
        2: color := clLime;
        3: color := clBlue;
    else
           color := clBlack;
    end;

    case (FillStyleGroup.ItemIndex) of
        0: style := bsSolid;
        1: style := bsClear;
        2: style := bsCross;
        3: style := bsDiagCross;
    else
           style := bsClear;
    end;

    // Save the command color and style.
    NewCmd.SetColorAndStyle(color, style);

    // If we are in the command history,
    // remove any future commands.
    while (NumCommands > LastCommand) do
    begin
        Commands[NumCommands].Free;
        NumCommands := NumCommands - 1;
    end;

    // Add the command to the list of commands.
    NumCommands := NumCommands + 1;
    Commands[NumCommands] := NewCmd;
    LastCommand := NumCommands;
    mnuUndo.Enabled := True;
    mnuRedo.Enabled := False;
end;

// Execute all of the drawing commands.
procedure TSerialForm.DrawCommands;
var
    i    : Integer;
    rect : TRect;
begin
    // Erase the canvas.
    rect.Left := 0;
    rect.Top := 0;
    rect.Right := DrawingArea.Width;
    rect.Bottom := DrawingArea.Height;
    DrawingArea.Canvas.Brush.Style := bsSolid;
    DrawingArea.Canvas.Brush.Color := clSilver;
    DrawingArea.Canvas.FillRect(rect);

    // Draw the commands.
    for i := 1 to LastCommand do
        Commands[i].Draw(DrawingArea.Canvas, True);
end;

procedure TSerialForm.FormCreate(Sender: TObject);
begin
    NumCommands := 0;
    LastCommand := 0;
    NewCmd := nil;
    DrawCommands;
    FileName := '';
    SetDataModified(False, True);
end;

// Draw the correct shape inside the bounding box.
procedure TSerialForm.DrawShape(x1, y1, x2, y2 : Integer);
begin
    NewCmd.SetPosition(x1, y1, x2, y2);
    NewCmd.Draw(DrawingArea.Canvas, False);
end;

// Undo the last command.
procedure TSerialForm.mnuUndoClick(Sender: TObject);
begin
    LastCommand := LastCommand - 1;
    if (LastCommand <= 0) then mnuUndo.Enabled := False;
    mnuRedo.Enabled := True;
    DrawCommands;

    // The data has been modified.
    SetDataModified(True, False);
end;

// Redo the last command.
procedure TSerialForm.mnuRedoClick(Sender: TObject);
begin
    LastCommand := LastCommand + 1;
    if (LastCommand >= NumCommands) then 
        mnuRedo.Enabled := False;
    mnuUndo.Enabled := True;
    DrawCommands;

    // The data has been modified.
    SetDataModified(True, False);
end;

// Return True if it is not safe to unload the data.
function TSerialForm.DataUnsafe : Boolean;
begin
    if (not DataModified) then
        DataUnsafe := False
    else begin
        case (MessageDlg(
            'The data has been modified. Do you want to save the changes?',
            mtConfirmation, mbYesNoCancel, 0))
        of
            mrYes:
                begin
                    // This resets DataModified if successful.
                    SaveData;
                    DataUnsafe := DataModified;
                end;
            mrNo:
                // Discard the changes.
                DataUnsafe := False;
            mrCancel:
                // Cancel the data discard.
                DataUnsafe := True;
        else
                // Cancel the data discard.
                DataUnsafe := True;
        end;
    end;
end;

// Save the data using the current file name.
procedure TSerialForm.SaveData;
begin
    if (FileName = '') then
        SaveDataAs
    else
        SaveTheData;
end;

// Let the user select a file name for saving.
procedure TSerialForm.SaveDataAs;
begin
    if (FileSaveDialog.Execute) then
    begin
        FileName := FileSaveDialog.FileName;
        SaveTheData;
    end;
end;

// Perform the actual data saving.
procedure TSerialForm.SaveTheData;
const
    CR = #13#10;
var
    ser      : String;
    i        : Integer;
    out_file : TextFile;
begin
    // Get the commands' serializations.
    ser := '';
    for i := 1 to LastCommand do
        ser := ser + Commands[i].Serialization + CR;

    // Write the serialization to the file.
    AssignFile(out_file, FileName);
    Rewrite(out_file);
    Write(out_file, ser);
    CloseFile(out_file);

    SetDataModified(False, False);
end;

// Perform the actual data loading.
procedure TSerialForm.LoadTheData;
var
    ser, txt, token_name, token_value : String;
    in_file                           : TextFile;
    cmd                               : TDrawingCommand;
begin
    // Read the serialization from the file.
    AssignFile(in_file, FileName);
    Reset(in_file);
    ser := '';
    while (not eof(in_file)) do
    begin
        Readln(in_file, txt);
        ser := ser + txt;
    end;
    CloseFile(in_file);

    // Create commands.
    while (ser <> '') do
    begin
        // Get the command name and serialization.
        GetToken(ser, token_name, token_value);
        if (token_name = 'TRectangleCmd') then
            cmd := TRectangleCmd.Create
        else if (token_name = 'TEllipseCmd') then
            cmd := TEllipseCmd.Create
        else if (token_name = 'TLineCmd') then
            cmd := TLineCmd.Create
        else
            cmd := nil;

        // If it's an unknown object, skip it.
        if (cmd = nil) then Continue;

        // Make the command object read its serialization.
        cmd.Deserialize(token_value);

        // Add the command to the list of commands.
        NumCommands := NumCommands + 1;
        Commands[NumCommands] := cmd;
        LastCommand := NumCommands;
    end;

    mnuUndo.Enabled := (NumCommands > 0);
    mnuRedo.Enabled := False;

    // The data has not yet changed.
    SetDataModified(False, True);
end;

// Create a new drawing.
procedure TSerialForm.mnuNewClick(Sender: TObject);
begin
    // Make sure the data is safe.
    if (DataUnsafe) then exit;

    MakeNew;
end;

// Create a new drawing assuming it's safe.
procedure TSerialForm.MakeNew;
begin
    // Remove all commands.
    while (NumCommands > 0) do
    begin
        Commands[NumCommands].Free;
        NumCommands := NumCommands - 1;
    end;
    LastCommand := 0;

    mnuUndo.Enabled := False;
    mnuRedo.Enabled := False;
    DrawCommands;
    FileName := '';
    SetDataModified(False, True);
end;

// Make sure it is safe to close.
procedure TSerialForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
    CanClose := (not DataUnsafe);
end;

// Save the data.
procedure TSerialForm.mnuSaveClick(Sender: TObject);
begin
    SaveData;
end;

// Let the user select a file name for saving.
procedure TSerialForm.mnuSaveAsClick(Sender: TObject);
begin
    SaveDataAs;
end;

// Let the user open a file.
procedure TSerialForm.mnuOpenClick(Sender: TObject);
begin
    // Make sure it's safe to remove the current data.
    if (DataUnsafe) then exit;

    if (FileOpenDialog.Execute) then
    begin
        // Remove any old commands.
        MakeNew;

        // Load the new data.
        FileName := FileOpenDialog.FileName;
        LoadTheData;
        DrawCommands;
    end;
end;

// Set DataModified and the form's Caption.
procedure TSerialForm.SetDataModified(value, force : Boolean);
begin
    if ((DataModified = value) and (not force)) then exit;
    DataModified := value;

    if (DataModified) then
        Caption := 'Serial*[' + FileName + ']'
    else
        Caption := 'Serial [' + FileName + ']';
end;

end.
