saveall

by James Hall: L6 Age ~17

Introduction

Program saveall is used by programs CrazyPaint and GameOfLife. Click on a filename in the white box to select it. If the filename is not visible and the box is full, use the mouse wheel to scroll through the list of names. You will be warned if you are about to replace an existing file and you can type a new name into the edit box. The filename is selected by making it the second line of allnames.txt, which the main program reads once saveall has ended.

The following screenshot shows the program in action.

Program saveall in action

Program saveall in action

Download the necessary files as described on the main Crazy Paint page.

The Program

program saveall;
{
    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;
  currname : string;
  mybitmap : file;
  bitmap : pointer;
  key : char;
  closegraphplease, rep, fin : boolean;
  i, j, numfiles, currline, tempnum : integer;

procedure putbut(x, y, num : integer; name : string);
var
  width, height, memorysize, temp : integer;
begin
  //Read data from bmp header.
  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);
  //Write action code to screen array.
  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);
  //Copy image from file to graphics window.
  assignfile(mybitmap, name);
  reset(mybitmap, 1);
  blockread(mybitmap, bitmap^, memorysize);
  closefile(mybitmap);
  putimage(x, y, bitmap^, copyput);
  freeMem(bitmap, memorysize);
end;

procedure updatebox;
begin
  setfillstyle(solidfill, white);
  setcolor(black);
  bar(20, 230, 200, 250);
  //Write current name to edit box.
  outtextxy(20, 230, currname);
  setcolor(white);
end;

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

procedure save;
begin
  updategraph(updateon);
  rep := false; //repeated name
  fin := false;
  for i := 1 to numfiles do
    if currname = names[i] then
      rep := true;
  if rep = true then
    begin
      cleardevice;
      outtextxy(40, 100, 'File already exists with that name.');
      outtextxy(40, 115, 'Overwrite it?');
      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
      //Write filenames to text file
      assignfile(datafile, 'savedata/allnames.txt');
      rewrite(datafile);
      if rep = false then
        begin
          inc(numfiles);
          names[numfiles] := currname;
        end;
      writeln(datafile, numfiles);
      writeln(datafile, currname); //Second line is filename required by CrazyPaint.
      for i := 1 to numfiles do
        writeln(datafile, names[i]);
      closefile(datafile);
      //Write '1' to a text file. Used by CrazyPaint to test setup.
      assignfile(datafile, 'savedata/saveint.txt');
      rewrite(datafile);
      writeln(datafile, '1');
      closefile(datafile);
    end;
  updategraph(updateoff);
end;

begin
  gd := 9;
  gm := 13;
  setwindowsize(400, 300);
  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/allnames.txt');
  reset(datafile);
  readln(datafile, numfiles);
  readln(datafile, currname);
  for i := 1 to numfiles + 1 do
    readln(datafile, names[i]);
  closefile(datafile);
  currline := 1;
  initgraph(gd, gm, 'Save Window');
  setbkcolor(lightgray);
  cleardevice;
  updategraph(updateoff);
  updatebox;
  updatefbox;
  //Put buttons on graphics window
  putbut(250, 80, 1, 'Icons/save.bmp');
  putbut(250, 120, 2, 'Icons/close.bmp');
  //Store action codes for mouse clicks on icons.
  for i := 20 to 200 do
    for j := 20 to 170 do
      screen[i, j] := 3;
  for i := 1 to 4 do
    if i <= numfiles then
      outtextxy(20, 10 + i * 10, names[currline + i - 1]);
  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
      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;
                        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 //backspace
                 currname := leftstr(currname, length(currname) - 1);
          #13 : save;
        end;
        updatebox;
      end;
    delay(50);
    updategraph(updatenow);
  until closegraphplease = true;
  closegraph;
end.

Remarks

Could you write your own combo box program?

Programming - a skill for life!

by James Hall: L6 Age ~17