savepatt

by James Hall: L6 Age ~17

Introduction

In order to run program savepatt, you will need to have downloaded Stefan Berinde`s wingraph.zip file as described in our Graphics tutorial. You should copy the unzipped wincrt.pas, winmouse,pas and wingraph.pas (from the src folder) into your program folder. (The compiled units are included in the zip file but you might as well have the source code available for reference). You should find these files useful for your own graphics programs.

When compiling program savepatt, use the Icons and savedata folders in gameoflife.zip that you can download from the main Game Of Life page. We showed this program in action on that page.

The Program

program savepatt;
{
    Copyright (c) 2011 James Hall

    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/
}
{$mode objfpc}{$H+}
{$APPTYPE GUI}
uses
  Classes, SysUtils, wingraph, wincrt, winmouse, strutils;
var
  gd, gm : smallint;
  screen, screen2 : array[1 .. 400, 1 .. 300] of integer;
  names : array[1 .. 100] of string;
  datafile : textfile;
  shstring: shortstring;
  currname : string;
  mybitmap : file;
  bitmap : pointer;
  key : char;
  closegraphplease, rep, fin : boolean;
  i, j, numfiles, currline, tempnum, barchosen, saveint, currpat : integer;

procedure putbut(x, y, num : integer; name : string);
//Writes buttons to screen and stores codes in screen array
var
  width, height, memorysize, temp : integer;
begin
  assignfile(mybitmap, name);
  reset(mybitmap, 1);
  blockread(mybitmap, temp, 2);
  for i := 1 to 4 do
    blockRead(mybitmap, temp, 4);
  blockread(mybitmap, width, 4);
  blockread(mybitmap, height, 4);
  closefile(mybitmap);

  for i := 1 to width do
    for j := 1 to height do
      screen[x - 1 + i, y - 1 + j] := num;
  memorysize := imageSize(1, 1, width, height);
  getMem(bitmap, memorysize);
  assignfile(mybitmap, name);
  reset(mybitmap, 1);
  blockread(mybitmap, bitmap^, memorysize);
  closefile(mybitmap);
  putimage(x, y, bitmap^, copyput);
  freeMem(bitmap, memorysize);
end;

procedure updatebox;
//Update display of current name
begin
  setfillstyle(solidfill, white);
  setcolor(black);
  bar(20, 230, 200, 250);
  outtextxy(20, 230, currname);
  setcolor(white);
end;

procedure updatefbox;
//Write filenames to white box
begin
  setfillstyle(solidfill, white);
  setcolor(black);
  bar(20, 20, 200, 180);
  for i := 1 to 15 do
    if i <= numfiles then
      outtextxy(20, 10 + i * 10, names[currline + i - 1]);
end;

procedure save;
  {Saves pattern names and current pattern to patternnames.txt,
  checking that name is not same as existing name}
begin
  updategraph(updateon);
  rep := false;
  fin := false;
  currpat := numfiles + 1;
  for i := 1 to numfiles do
    if currname = names[i] then
      begin
        rep := true;
        currpat := i;
      end;
  if rep = true then
    begin
      cleardevice;
      outtextxy(40, 100, 'File already exists with that name.');
      outtextxy(40, 115, 'Overwrite it?');
      //Draw Yes and No buttons
      setfillstyle(solidfill, gray);
      bar(50, 130, 125, 160);
      bar(150, 130, 225, 160);
      outtextxy(80, 140, 'Yes');
      outtextxy(180, 140, 'No');
      repeat
        case getmousebuttons of
          mouseleftbutton : case screen2[getmousex, getmousey] of
                              1 : begin
                                    fin := true;
                                    closegraphplease := true;
                                  end;
                              2 : begin
                                    fin := true;
                                  end;
                            end;
        end;
      until fin = true;
      if closegraphplease = false then
        begin
          cleardevice;
          updatebox;
          updatefbox;
          putbut(250, 80, 1, 'Icons/save.bmp');
          putbut(250, 120, 2, 'Icons/close.bmp');
        end;
    end;
  if rep = false then
    closegraphplease := true;
  if closegraphplease = true then
    begin
      //Save pattern names
      assignfile(datafile, 'savedata/patternnames.txt');
      rewrite(datafile);
      if rep = false then
        begin
          inc(numfiles);
          names[numfiles] := currname;
        end;
      writeln(datafile, numfiles);
      writeln(datafile, currpat);
      for i := 1 to numfiles do
        writeln(datafile, names[i]);
      closefile(datafile);
      //Use following for checking setup by main program
      assignfile(datafile, 'savedata/saveint.txt');
      rewrite(datafile);
      writeln(datafile, '1');
      closefile(datafile);
    end;
  updategraph(updateoff);
end;

begin
  gd := 9;
  gm := 13;
  setwindowsize(400, 300);
  barchosen := 1;
  closegraphplease := false;
  for i := 1 to 400 do
    for j := 1 to 300 do
      screen[i, j] := 0;
  for i := 1 to 400 do
    for j := 1 to 300 do
      screen2[i, j] := 0;
  assignfile(datafile, 'savedata/patternnames.txt');
  reset(datafile);
  readln(datafile, numfiles);
  readln(datafile, currpat);
  for i := 1 to numfiles + 1 do
    readln(datafile, names[i]);
  closefile(datafile);
  currname := names[currpat];
  currline := 1;
  initgraph(gd, gm, 'Save Window');
  setbkcolor(lightgray);
  cleardevice;
  updategraph(updateoff);
  updatebox;
  updatefbox;
  //Draw buttons
  putbut(250, 80, 1, 'Icons/save.bmp');
  putbut(250, 120, 2, 'Icons/close.bmp');
  //Store codes for buttons in screen arrays
  for i := 20 to 200 do
    for j := 20 to 170 do
      screen[i, j] := 3;
  for i := 20 to 200 do
    for j := 230 to 250 do
      screen[i, j] := 4;
  for i := 1 to 4 do
    if i <= numfiles then
      outtextxy(20, 10 + i * 10, names[currline + i - 1]);
  //Yes and No buttons use Screen2 array
  for i := 50 to 125 do
    for j := 130 to 160 do
      screen2[i, j] := 1;
  for i := 150 to 225 do
    for j := 130 to 160 do
      screen2[i, j] := 2;
  repeat
    case getmousewheel of  //Scroll
      120 : begin
              if currline > 1 then
                dec(currline);
              updatefbox;
            end;
      -120 : begin
               if currline < numfiles - 14 then
                 inc(currline);
               updatefbox;
             end;
    end;
    case getmousebuttons of
      mouseleftbutton : case screen[getmousex, getmousey] of
                          1 : save;
                          2 : closegraphplease := true;
                          3 : begin
                                tempnum := (getmousey - 15) div 10;
                                if (tempnum <= numfiles) and (tempnum > 0) then
                                  currname := names[tempnum + currline - 1];
                                updatebox;
                              end;
                          4 : begin
                                barchosen := 1;
                              end;
                        end;
    end;
    if keypressed then
      begin
        key := readkey;
        case key of
          'A'..'Z', 'a'..'z', '0'..'9' : if length(currname) < 20 then
                                           currname := currname + key;
           #8 : if currname <> '' then
                  currname := leftstr(currname, length(currname) - 1);
           #13 : save;  
        end;
        updatebox;
      end;
    delay(50);
    updategraph(updatenow);
  until closegraphplease = true;
  closegraph;
end.
Programming - a skill for life!

by James Hall: L6 Age ~17