uses Win95Btn, Mouse, Crt, Graph, grptools, YFonts;

var
 NetX , NetY ,
 NetX1, NetY1,
 NetLx, NetLy  : integer;
 Rix, Riy      : integer;
 Icon1         : IconType;
 MaskMode      : boolean;
 Pressed       : boolean;

Procedure MakeNet(x,y,x1,y1,lx,ly : integer);
var
 i : integer;
begin
   NetX := x; NetY := y; NetX1 := x1; NetY1 := y1;
   NetLx := lx; NetLy := ly;

   SetColor(0);
   SetFillStyle(1,15);
   Bar(x,y,x+(x1*lx),y+(y1*ly));

   Rectangle(x,y,x+(x1*lx),y+(y1*ly));

   for i := 1 to x1 do
     Line(x+(i-1)*lx,y,x+(i-1)*lx,y+(y1*ly));

   for i := 1 to y1 do
     Line(x,y+(i-1)*ly,x+(x1*lx),y+(i-1)*ly);
end;

Procedure FillDot(x,y : integer; color : byte);
begin
   if Pressed then
   begin
      Pressed := false;
      if (Icon1.data[y,x] = color) and (not maskmode) then
           exit;
      if (maskmode) and ((((icon1.mask[y,x] = false) and (color = 15)))or
                        (((icon1.mask[y,x] = true ) and (color =  0)))) then
                            exit;
   end;
   HideMouse;
   SetFillStyle(1,Color);
   Bar(netX+((x-1)*netlx)+1,netY+((y-1)*netly+1),
       netX+((x-1)*netlx)+netlx-1,netY+((y-1)*netly)+netly-1);
   if not maskmode then
   begin
      PutPixel(Rix+x, Riy+y, color);
      if Icon1.mask[y,x] then
        PutPixel(Rix+x-50, Riy+y, color)
       else
        if Color <> 15 then
          PutPixel(Rix+x-50, Riy+y, color)
         else
          PutPixel(Rix+x-50, Riy+y, LightBlue);

      if color = 15 then
        Icon1.data[y,x] := 15
       else
        Icon1.data[y,x] := Color;
   end
  else
   begin
     if Color = 15 then Icon1.mask[y,x] := false
    else
     if Color =  0 then Icon1.mask[y,x] := true;

     if Icon1.mask[y,x] then
       PutPixel(Rix+x-50, Riy+y, Icon1.data[y,x])
      else
       if Icon1.Data[y,x] = 15 then
         PutPixel(Rix+x-50, Riy+y, LightBlue)

   end;
   ShowMouse;
   Pressed := false;
end;

Procedure Clear; Forward;
Procedure DrawMaskPic; forward;
Procedure ReDrawIcon; forward;

procedure LOAD_ICON(xx,yy :integer;filename :string);

var
  r,rr :byte;
  f    :text;
  ch   :char;
  x,y,p,q : integer;
begin
  Clear;
  x :=xx;y :=yy;
  assign(f,filename);
  {$I-} reset(f); {$I+}
  if ioresult =0 then begin
    for p :=1 to 766 do begin
      read(f,ch);q :=ord(ch);
      if (p >126) and (p <639) then begin
        r :=q shr 4;rr :=q-r div 16;
        Icon1.Data[y,x] := r; Icon1.Data[y,x+1]:=rr;
        inc(x,2);
        if x =xx+32 then begin
          x :=xx;dec(y);
        end;
      end;
    end;
    close(f);
  end;
  for y := 1 to 32 do
    for x := 1 to 32 do
     Icon1.Mask[y,x] := false;
  Redrawicon;
  DrawMaskPic;
end;

procedure SAVE_ICON(x,y :integer;filenaam :string);

const
  iconkop :array[1..126] of byte =
          (0,0,1,0,1,0,32,32,16,0,0,0,0,0,232,2,0,0,22,0,0,
           0,40,0,0,0,32,0,0,0,64,0,0,0,1,0,4,0,0,0,0,0,
           128,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    { 0}   0,0,0,0,
    { 1}   170,0,0,0,
    { 2}   0,170,0,0,
    { 3}   170,170,0,0,
    { 4}   0,0,170,0,              { 0 t/m 15 are the 16 colours }
    { 5}   170,0,170,0,
    { 6}   0,85,170,0,
    { 7}   170,170,170,0,
    { 8}   85,85,85,0,
    { 9}   255,0,0,0,
    {10}   0,255,0,0,
    {11}   255,255,0,0,
    {12}   0,0,255,0,
    {13}   255,0,255,0,
    {14}   0,255,255,0,
    {15}   255,255,255,0);

var
  f        :file;
  r,rr,pal   :byte;
  p,xx,yy    :integer;

begin
  assign(f,filenaam);
  rewrite(f,1);
  for p :=1 to 126 do blockwrite(f,iconkop[p],1);
  for yy :=y+31 downto y do begin
    for xx :=x to x+31 do begin
      r :=GetPixel(xx,yy);
      rr :=GetPixel(xx+1,yy);
      pal :=(r*16)+rr;
      blockwrite(f,pal,1);
      inc(xx);
    end;
  end;
  xx :=0;
  for p :=1 to 128 do blockwrite(f,xx,1);
  close(f);
end;

Procedure MaskModeOff; forward;

Procedure YLoad_Icon(x,y : integer; Fname : string);
var
 F  : file of IconType;
 i, j  : integer;
begin
   if FName = '' then Exit;
   if MaskMode then
     MaskModeOff;
   Assign(F,FName);
   Reset(f);
   {$I-}Read(F,Icon1);{$I+}
   if IOResult <> 0 then
   begin
      GMessage('Procedure: YLoad_Icon:                \n\n'+
               'File read error!, invalid record type!','Error');
      Exit;
   end;
   Close(F);

   ReDrawIcon;
   DrawMaskPic;
end;


Procedure ReDrawIcon;
var
 i, j  : integer;
begin
   for j := 1 to 32 do
    for i := 1 to 32 do
     FillDot(i,j,icon1.data[j,i]);
   DrawMaskPic;
end;


Procedure MakeButton(x,y : integer; B : TButton);
begin
   B.X  := netX+((x-1)*netlx)+1;
   B.Y  := netY+((y-1)*netly)+1;
   B.X1 := netX+((x-1)*netlx)+netlx-1;
   B.Y1 := netY+((y-1)*netly)+netly-1;
end;

Procedure PutOn(Color : byte);
var
 x,y,mx,my : integer;
begin
   mx := getmousex; my := getmousey;
   if not((mx >= netx) and (mx <= (netx1+13)*netlx) and
          (my >= nety) and (my <= (nety1+14)*netly)) then Exit;
   Pressed := true;
   x := (mx-netx) div netlx+1;
   y := (my-nety) div netly+1;
   FillDot(x,y,color);
end;

var
 Colors  : Array[0..15] of Button;
 Buttons : Array[1..04] of Button;

Procedure InitColors;
var
 i  : integer;
 ix, iy : integer;
begin
   ix := 402;
   iy := 132;
   for i := 0 to 15 do
   begin
      Colors[i].x := ix;
      Colors[i].x1 := ix+27;
      Colors[i].y := iy;
      Colors[i].y1 := iy+25;
      Inc(ix, 29);
      if ix >= 518 then
      begin
         ix := 402;
         inc(iy,26);
      end;
   end;
end;

Procedure DrawColors;
var
 i  : integer;
begin
   HideMouse;
   for i := 0 to 15 do
   begin
      SetFillStyle(1,i);
      with colors[i] do
      begin
         Bar(x,y,x1,y1);
         SetColor(15);
         Rectangle(x,y,x1,y1);
      end;
   end;
   showmouse;

end;

Procedure InitButtons;
begin
   with buttons[1] do
   begin
      x := 105; y:= 92; x1 := 185; y1 := 112; name := 'File';
      picfname := '';
   end;

   with buttons[2] do
   begin
      x := 195; y:= 92; x1 := 275; y1 := 112; name := 'Edit';
      picfname := '';
   end;
end;

Procedure DisplayButtons;
var
 i : integer;
begin
   InitButtons;
   for i := 1 to 2 do
   begin
      Draw_Button(Buttons[i],0,f);
   end;
end;

var
 Gd, Gm : integer;
 C      : byte;

Procedure DispColor;
begin
   HideMouse;
   SetFillStyle(1,c);
   Bar(401,237,519,259);
   ShowMouse;
end;

Procedure YSetColor;
var
 i : integer;
 mx,my : integer;
begin
   mx := getmousex; my := getmousey;
   for i := 0 to 15 do
   begin
      with colors[i] do
      begin
         if (mx >= x) and (mx <= x1) and
            (my >= y) and (my <= y1) then
            begin
               c:= i;
               DispColor;
            end;
      end;
   end;
end;

Procedure DrawMaskPic;
var
 i,j : integer;
begin
   SetFillStyle(1,LightBlue);
   Bar(Rix-50, Riy, Rix+33-50, Riy+33);
   for j := 1 to 32 do
    for i := 1 to 32 do
     if Icon1.mask[j,i] then
      PutPixel(Rix+i-50, Riy+j, Icon1.data[j,i])
     else
      if Icon1.data[j,i] <> 15 then
        PutPixel(Rix+i-50, Riy+j, Icon1.data[j,i]);
end;

Procedure MaskModeOn;
var
 i,j : integer;
begin
   MaskMode := true;
   for j := 1 to 32 do
    for i := 1 to 32 do
     if Icon1.mask[j,i] then FillDot(i,j,0)
    else
     FillDot(I,J,15);
   DrawMaskPic;
end;

Procedure MaskModeOff;
var
 j,i : integer;
begin
   MaskMode := false;
   for j := 1 to 32 do
    for i := 1 to 32 do
     FillDot(I,J,Icon1.Data[j,i]);
   DrawMaskPic;
end;

Procedure SaveYCO(FN : String);
var
  f : file of Icontype;
begin
   if FN = '' then Exit;
   Assign(F,FN);
   Rewrite(F);
   Write(F,Icon1);
   Close(F);
end;

Procedure Clear;
var
 j,i : integer;
begin
   for j := 1 to 32 do
    for i := 1 to 32 do
     Icon1.Data[j,i] := 15;

   for j := 1 to 32 do
    for i := 1 to 32 do
     Icon1.mask[j,i] := false;

end;

var
 i,j : integer;
 m1,m2  : TItemsP;
 R   : TMRType;
 done : boolean;
 ch : char;
begin
   Clear;
   InitGraph(Gd, Gm, '');
   LoadYTF('win95.ytf');
   SetFillStyle(1,3);
   c := 0;
   Bar(0,0,getmaxx, getmaxy);
   SetTextStyle(7,HorizDir,2);
   OuttextXY(20,20,'Y.M.S Icons create');
   WWindow(80,70,590,390,'BitMap Constructor');

   Rectangle(400,130,520,260);
   SetColor(8);
   Rectangle(401,131,519,259);

   MakeNet(105,115,32,32,8,8);
   SetFillStyle(1,15);
   rix := 480; riy := 280;
   Bar(Rix, Riy, Rix+33, Riy+33);
   DrawMaskPic;
   initColors;
   drawColors;
   DispColor;
   DisplayButtons;
   maskmode := false;
   new(m1);
   m1^.Count := 4;
   for i := 1 to m1^.Count do
    m1^.it[i].Cont := false;

   m1^.it[1].s := 'Edit icon';
   m1^.it[2].s := 'Edit mask';
   m1^.it[3].s := 'Fill mask';
   m1^.it[4].s := 'Unfill mask';

   new(m2);
   m2^.Count := 7;
   for i := 1 to m2^.Count do
    m2^.it[i].Cont := false;

   m2^.it[1].s := 'New';
   m2^.it[2].s := 'Open';
   m2^.it[3].s := 'Save';
   m2^.it[4].s := 'Export .ico';
   m2^.it[5].s := 'Import .ico';
   m2^.it[6].s := '-';
   m2^.it[7].s := 'Close';
   initmouse;
   showmouse;

   done := false;
   repeat
      Pressed := false;
      if keypressed then ch:=readkey;
      if (ch = 'q')then done := true;
      if LButtonDown then
      begin
         if maskmode then
          PutOn(0)
         else
          PutOn(c);
      end;
      if RButtonDown then
      begin
         PutOn(15);
      end;
      if Mouse.ButtonDown then
      begin
         if not maskmode then YSetColor;
         if chekbutton(buttons[1],getmousex,getmousey) then
         begin
            if ( pressbutton(buttons[1],1)) then
            begin
               ShowMouse;
               r.s := '';
               PerformMenuItems(m2^,False,buttons[1].x, buttons[1].y1,R,0);
               if R.s = 'New' then
               begin
                  if MaskMode then maskmodeOff;
                  Clear;
                  ReDrawIcon;
                  DrawMaskPic;
               end;
               if R.s = 'Open' then
                 YLoad_Icon(1,32,GOpenDialog('*.yco'));
               if R.s = 'Import .ico' then
                 Load_Icon(1,32,GOpenDialog('*.ico'));
               if R.s = 'Export .ico' then
                 Save_Icon(rix+1,riy+1,GSaveDialog('*.ico'));
               if R.s = 'Save' then
                 SaveYCO(GSaveDialog('*.yco'));

               if R.s = 'Close' then
                Done := true;
            end;
         end
        else
         if chekbutton(buttons[2],getmousex,getmousey) then
         begin
            if (PressButton(buttons[2],1)) then
            begin
               ShowMouse;
               r.s := '';
               PerformMenuItems(m1^,False,buttons[2].x, buttons[2].y1,R,0);
               if R.s = 'Edit icon' then
                 maskmodeOff;
               if R.s = 'Edit mask' then
                 maskmodeOn;
               if R.s = 'Fill mask' then
               begin
                  if maskmode = false then
                   maskmodeOn;
                  for j := 1 to 32 do
                   for i := 1 to 32 do
                    FillDot(i,j,0);
               end;
               if R.s = 'Unfill mask' then
               begin
                  if maskmode = false then
                   maskmodeOn;
                  for j := 1 to 32 do
                   for i := 1 to 32 do
                    FillDot(i,j,15);
               end;
            end;
         end;
      end;
   until done;
   Closegraph;
end.