Tank battle game.
{$A+,B+,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16000,0,400000}
Unit Service;
Interface
Uses
crt, graph, dos, globals, mouse, buttons, menus, general;
Const
MENU_ITEM_LIST_MainMenu : array [ 0..2 ] of String = (
'File',
'Edit',
'Help' );
MENU_ITEM_LIST_ClosedImage : array [ 0..4 ] of String = (
'New',
'Open',
'Paste',
'Put',
'Move' );
MENU_ITEM_LIST_OpenedImage : array [ 0..8 ] of String = (
'New',
'Open',
'Save',
'Close',
'Smart edit',
'Copy',
'Paste',
'Put',
'Move' );
MENU_MAXITEMS_MainMenu = 3;
MENU_MAXITEMS_ClosedImage = 5;
MENU_MAXITEMS_OpenedImage = 9;
{ MENU_ITEM_MAP_NewProject : array[0..MENU_MAXITEMS_ClosedImage-1] of Byte=(
1,
1,
1,
0,
0,
1); }
PhantomColor = 14;
PhantomColorNum = 255;
PhantomColorStyle = 9;
PATH_TO_SHELL = 'SHELL\';
PATH_TO_POINTERS = 'POINTERS\';
Type
ImageBitType = record
BitX : Byte;
BitY : Byte;
BitSize : Byte;
BitColor : Byte;
BitStyle : Byte;
end;
TriggerType = record
Palette : Boolean;
Grid : Boolean;
FillMode : Boolean;
BorrowColor : Boolean;
end;
ColorType = record
Foreground : Byte;
Background : Byte;
CustomForeground : Byte;
CustomBackground : Byte;
BorrowLEFT : Byte;
BorrowRIGHT : Byte;
end;
GridType = record
GridClip : Byte;
GridColor : Byte;
PutGrid : procedure;
end;
MainPaletteType = array[ 0..15, 0..15 ] of Byte;
CustomPaletteType = array[ 0..29, 0..5 ] of Byte;
OpNameType = ( Copy, Paste, Put, Move );
ClipboardType = array [ 0..50, 0..50 ] of Byte;
ResizableImage = array [ 0..0 ] of Byte;
ResImageP = ^ResizableImage;
ImageBox = record
Flag : Boolean;
Data : ResImageP;
end;
Var
VERSION_NUMBER : Byte;
ImagesByX : Word;
ImagesByY : Word;
ImageCageX : Byte;
ImageCageY : Byte;
OldImageCageX : Byte;
OldImageCageY : Byte;
PutCustCol : Boolean;
CustColManager : Integer;
Color : ColorType;
Trigger : TriggerType;
Button : ButtonType;
MainPalette : ^MainPaletteType;
CustPal : ^CustomPaletteType;
Grid : GridType;
iSizeX : Byte;
iSizeY : Byte;
iBit : ImageBitType;
AxisX : Byte;
AxisY : Byte;
OldAxisX : Byte;
OldAxisY : Byte;
OldManager : Byte;
Manager : Byte;
FrInMan : LongInt;
ManagerA : Byte;
NewProjectFlag : Boolean;
SelectImX : Byte;
SelectImY : Byte;
OldSelectImX : Byte;
OldSelectImY : Byte;
SelectedImage : Word;
Image : array[ 0..69, 0..69 ] of ImageBox;
Clipboard : ^ClipboardType;
{ C }
Procedure ClosedMainImage;
Procedure CloseImage;
Procedure CopyImage;
{ D }
Procedure DrawDesktop;
{ E }
Procedure EditImage(Color:Byte);
{ F }
Procedure FillCustomPalette;
{ G }
Procedure GetCustomColor;
Procedure GetInfo(MsgNum:Byte);
Function GetMainColor : Word;
Procedure GridColorManager(GridColManX,GridColManY:Integer);
{ I }
Procedure ImageCage( ImCageXstart, ImCageYstart : Integer );
Procedure ImageSizeManager(PosX,PosY:Integer);
{ L }
Procedure LoadCustomPalette;
Procedure LoadImage;
Procedure LMBOpsWithImages;
{ M }
Procedure MoveImage;
{ O }
Procedure OpenNewImage;
pROCEDURE Operation( OpName : OpNameType );
{ P }
Procedure PasteImage;
Procedure PutIcon(PosX,PosY:Word;IconName:String);
Procedure PutSpinner(SpinX,SpinY:Integer);
{ R }
Procedure RefreshCustomPalette;
Procedure RefreshCurrentImage;
Procedure RMBOpsWithImages;
{ S }
Procedure SaveCustomPalette;
Procedure SaveImage;
Procedure ShowCurrentImageBit;
Procedure ShowCurrentImageSize;
Procedure SetNewProject(WinCoordX,WinCoordY:Integer);
Implementation
{----------------------------------------------------------------------------}
Procedure CloseImage;
begin
Image[ SelectImX, SelectImY ].Flag := False;
FreeMem( Image[ SelectImX, SelectImY ].Data, iSizeX * iSizeY );
ImageCage( 276 + SelectImX * iSizeX, 58 + SelectImY * iSizeY);
ClosedMainImage;
end;{of 'CloseImage'}
{----------------------------------------------------------------------------}
Procedure ClosedMainImage;
begin
BarDeluxe( 11, 59, iSizeX * iBit.BitSize - 2, iSizeY * iBit.BitSize - 2, 1, 0 );
SetColor( 31 );
Line( 11, 59, 11 + iSizeX * iBit.BitSize - 2, 59 + iSizeY * iBit.BitSize - 2 );
Line( 11 + iSizeX * iBit.BitSize - 2, 59, 11, 59 + iSizeY * iBit.BitSize - 2 );
end;{of 'ClosedMainImage'}
{----------------------------------------------------------------------------}
Procedure CopyImage;
begin
{ for CntY := 0 to iSizeY - 1 do
for CntX := 0 to iSizeX - 1 do
Clipboard^[ CntX, CntY ] := Image[ SelectImX, SelectImY ].Data^[ CntX + CntY * iSizeY ];
}end;
{----------------------------------------------------------------------------}
Procedure EditImage;
Var
StartX : Word;
StartY : Word;
GetImageElement_X : Byte;
GetImageElement_Y : Byte;
begin
MouseHide;
GetImageElement_X := ( m_X_coord - 10 ) div iBit.BitSize;
GetImageElement_Y := ( m_Y_coord - 58 ) div iBit.BitSize;
Image[ SelectImX, SelectImY ].Data^[ GetImageElement_X + GetImageElement_Y * iSizeX ] := Color;
if Color = PhantomColorNum then
BarDeluxe( 11 + GetImageElement_X * iBit.BitSize, 59 + GetImageElement_Y * iBit.BitSize,
iBit.BitSize - 2, iBit.BitSize - 2, PhantomColorStyle, PhantomColor )
else
BarDeluxe( 11 + GetImageElement_X * iBit.BitSize, 59 + GetImageElement_Y * iBit.BitSize,
iBit.BitSize - 2, iBit.BitSize - 2, 1, Color );
StartX := 276 + SelectImx * iSizeX;
StartY := 58 + SelectImy * iSizeY;
PutPixel( StartX + GetImageElement_X, StartY + GetImageElement_Y,
Image[ SelectImX, SelectImY ].Data^[ GetImageElement_X + GetImageElement_Y * iSizeX ] );
MouseShow;
end;
{----------------------------------------------------------------------------}
Procedure FillCustomPalette;
Var
PalX : Byte;
PalY : Byte;
FillColor : Byte;
begin
if m_BUTTON=1 then FillColor:=Color.Foreground else FillColor:=Color.Background;
PalX:=(m_X_coord-312) div 16;
PalY:=(m_Y_coord-495) div 16;
CustPal^[PalX,PalY]:=FillColor;
BarDeluxe(313+PalX*16,497+PalY*16,12,12,1,FillColor);
end;
{----------------------------------------------------------------------------}
Procedure GetCustomColor;
Var
PalX : Byte;
PalY : Byte;
begin
PalX:=(m_X_coord-312) div 16;
PalY:=(m_Y_coord-495) div 16;
if m_BUTTON=1 then
begin
Color.CustomForeground:=CustPal^[PalX,PalY];
BarDeluxe(277,497,22,16,1,Color.CustomForeground);
end
else
begin
Color.CustomBackground:=CustPal^[PalX,PalY];
BarDeluxe(277,535,22,16,1,Color.CustomBackground);
end;
end;
{----------------------------------------------------------------------------}
Procedure GetInfo;
Const
MessageBox : array [0..13] of String =(
'',
{1} 'Here you can draw image',
{2} 'Click here to select color',
{3} 'Color of left mouse button',
{4} 'Color of middle mouse button',
{5} 'Color of right mouse button',
{6} 'Click here to create',
{7} 'Custom color bar for left mouse button',
{8} 'Custom color bar for middle mouse button',
{9} 'Custom color bar for right mouse button',
{10} 'Click here to create custom palette',
{11} '',
{12} '',
{13} '');
begin
SetColor(40);
SetTextStyle(0,0,0);
OutTextXY(281,310,MessageBox[MsgNum]);
end;{of 'GetInfo'}
{----------------------------------------------------------------------------}
Function GetMainColor;
Var
Color : Byte;
SiteX : Word;
SiteY : Word;
begin
SiteX := ( m_X_coord - 10 ) div 14;
SiteY := ( m_Y_coord - 324 ) div 14;
Color := MainPalette^[ SiteX, SiteY ];
if Color = PhantomColorNum then if m_BUTTON = 1 then BarDeluxe( 11, 553, 106, 18, PhantomColorStyle, PhantomColor )
else BarDeluxe( 125, 553, 106, 18, PhantomColorStyle, PhantomColor );
if Color <> PhantomColorNum then if m_BUTTON = 1 then BarDeluxe( 11, 553, 106, 18, 1, Color )
else BarDeluxe( 125, 553, 106, 18, 1, Color );
GetMainColor := MainPalette^[ SiteX, SiteY ];
end;
{----------------------------------------------------------------------------}
Procedure GridColorManager;
Const
WinWidth = 305;
WinHeight = 260;
Palette : array[0..29] of Byte=( 0 ,104 , 2 , 3 , 4 , 6,
7 , 8 ,140 , 150, 1 , 1,
1 , 1 , 1 , 1 , 1 , 1,
1 , 1 , 1 , 1 , 1 , 1,
1 , 1 , 1 , 1 , 1 , 1 );
Var
OldColor : Byte;
WorkColor : Byte;
begin
OldColor:=Grid.GridColor;
WorkColor:=Grid.GridColor;
PutIcon(304,32,PATH_TO_SHELL+'gridpal1'); { *** Grid color icon *** }
CreateWindow(GridColManX,GridColManY,WinWidth,WinHeight,'Grid color manager');
Area(GridColManX+10,GridColManY+40,115,110,'Palette');
{ *** Draw palette *** }
for AxisY:=0 to 4 do
for AxisX:=0 to 5 do
Panel(GridColManX+20+AxisX*16,GridColManY+60+AxisY*16,14,14,22,Palette[AxisX+AxisY*5],31);
Area(GridColManX+10,GridColManY+170,135,75,'Selected color');
Panel(GridColManX+20,GridColManY+189,115,46,COLOR_3,{Color}0,COLOR_1);
SetColor(OldColor);
for AxisY:=0 to 7 do
for AxisX:=0 to 18 do
begin
Line(GridColManX+23+AxisX*6,GridColManY+190,GridColManX+23+AxisX*6,GridColManY+234);{V}
Line(GridColManX+21,GridColManY+191+AxisY*6,GridColManX+134,GridColManY+191+AxisY*6);{H}
end;
Area(GridColManX+160,GridColManY+150,135,95,'Current color');
Panel(GridColManX+170,GridColManY+170,115,65,COLOR_3,0,COLOR_1);
SetColor(Grid.GridColor);
for AxisY:=0 to 10 do
for AxisX:=0 to 18 do
begin
Line(GridColManX+172+AxisX*6,GridColManY+171,GridColManX+172+AxisX*6,GridColManY+234);{V}
Line(GridColManX+171,GridColManY+172+AxisY*6,GridColManX+285,GridColManY+172+AxisY*6);{H}
end;
InitButton(GridColManX+160,GridColManY+40,0,0,'OK',OK);
InitButton(GridColManX+160,GridColManY+70,0,0,'Cancel',Cancel);
InitButton(GridColManX+160,GridColManY+100,0,0,'Apply',Apply);
repeat
Old_m_X_coord:=m_X_coord;
Old_m_Y_coord:=m_Y_coord;
MouseRead(m_X_coord,m_Y_coord,m_BUTTON);
if (m_X_coord<>Old_m_X_coord) or (m_Y_coord<>Old_m_Y_coord) then MouseDraw;
if m_BUTTON=1 then
if not disableLMB then
begin
disableLMB:=True;
if ((m_X_coord>GridColManX+20) and (m_X_coord<GridColManX+114)) and ((m_Y_coord>GridColManY+40)
and (m_Y_coord<GridColManY+130)) then
begin
AxisX:=(m_X_coord-GridColManX-20) div 16;
AxisY:=(m_Y_coord-GridColManY-60) div 16;
WorkColor:=Palette[AxisX+AxisY*5];
SetColor(WorkColor);
for AxisY:=0 to 7 do
for AxisX:=0 to 18 do
begin
Line(GridColManX+23+AxisX*6,GridColManY+190,GridColManX+23+AxisX*6,GridColManY+234);{V}
Line(GridColManX+21,GridColManY+191+AxisY*6,GridColManX+134,GridColManY+191+AxisY*6);{H}
end;
end;
(* case GetButton(m_X_coord,m_Y_coord) of
OK : begin
Grid.GridColor:=WorkColor;
if Trigger.Grid then
begin
SetColor(Grid.GridColor);
for AxisY:=1 to iSizeY do
for AxisX:=1 to iSizeX do Rectangle(10+AxisX*iBit.BitSize-iBit.BitSize,
40+AxisY*iBit.BitSize-iBit.BitSize,
10+AxisX*iBit.BitSize,40+AxisY*iBit.BitSize);
end;
ClearWindow(GridColManX,GridColManY,WinWidth,WinHeight);
PutIcon(296,6,PATH_TO_SHELL+'gridpal0'); {Grid color icon}
Exit;
end;
Cancel : begin
Grid.GridColor:=OldColor;
ClearWindow(GridColManX,GridColManX,WinWidth,WinHeight);
PutIcon(296,6,PATH_TO_SHELL+'gridpal0'); {Grid color icon}
Exit;
end;
Apply : begin
Grid.GridColor:=WorkColor;
SetColor(Grid.GridColor);
for AxisY:=0 to 10 do
for AxisX:=0 to 10 do
begin
Line(GridColManX+142+AxisX*6,GridColManY+121,GridColManX+142+AxisX*6,GridColManY+184);{V}
Line(GridColManX+141,GridColManY+122+AxisY*6,GridColManX+205,GridColManY+122+AxisY*6);{H}
end;
end;
end;{case} *)
end else disableLMB:=False;{ of LEFT button }
if KeyPressed then { *** Keyboard control *** }
begin
Key:=ReadKey;
if Key=#27 then
begin
Exit;
end;
end;
until m_BUTTON=2;
Grid.GridColor:=WorkColor;
PutIcon(304,32,PATH_TO_SHELL+'gridpal0'); { *** Grid color icon *** }
end;{of 'GridColorManager'}
{----------------------------------------------------------------------------}
Procedure ImageCage;
begin
BarDeluxe( ImCageXstart, ImCageYstart, iSizeX - 2, iSizeY - 2, 1, 0 );
SetColor( 28 );
Rectangle( ImCageXstart, ImCageYstart, ImCageXstart + iSizeX - 1, ImCageYstart + iSizeY - 1 );
Line( ImCageXstart + 1, ImCageYstart + 1, ImCageXstart + iSizeX - 2, ImCageYstart + iSizeY - 2);
Line( ImCageXstart + iSizeX - 2, ImCageYstart + 1, ImCageXstart + 1, ImCageYstart + iSizeY - 2);
end;
{----------------------------------------------------------------------------}
Procedure ImageSizeManager;
begin
end;{of 'ImageSizeManager'}
{----------------------------------------------------------------------------}
Procedure DrawDesktop;
var
tmpX : integer;
tmpY : integer;
begin
{ *** Set image bit size *** }
if iSizeX>iSizeY then iBit.BitSize:= 256 div iSizeX;
if iSizeY>iSizeX then iBit.BitSize:= 256 div iSizeY;
if iSizeX=iSizeY then iBit.BitSize:= 256 div iSizeX;
if iBit.BitSize>14 then iBit.BitSize:=14;
{ *** Init all images *** }
for AxisY := 0 to ImagesByY do
for AxisX := 0 to ImagesByX do
begin
Image[ AxisX, AxisY ].Flag := False;
for tmpY := 0 to iSizeY - 1 do
for tmpX := 0 to iSizeX - 1 do
Image[ AxisX, AxisY ].Data^[ tmpX + tmpY * iSizeX ] := 0;
end;
{ Initialize main palette }
for AxisY := 0 to 15 do
for AxisX := 0 to 15 do
MainPalette^[ AxisX, AxisY ] := AxisX + 16 * AxisY;
MainPalette^[ 7, 15 ] := 22;
MainPalette^[ 8, 15 ] := 23;
MainPalette^[ 9, 15 ] := 24;
MainPalette^[ 10, 15 ] := 25;
MainPalette^[ 11, 15 ] := 26;
MainPalette^[ 12, 15 ] := COLOR_2;
MainPalette^[ 13, 15 ] := 28;
MainPalette^[ 14, 15 ] := 29;
MainPalette^[ 15, 15 ] := PhantomColorNum;
CreateWindow( 0, 0, GetMaxX, GetMaxY, 'Atomizer' );
Area( 4, 24, 204, 22, '' );
BarDeluxe( 8, 28, 30, 14, 1, 105 );
SetColor( 15 );
{SetStandardFont;}
OutTextXY( 13, 29, 'File' );
{Main image window}
{Here you can draw image}
Panel( 10, 58, iSizeX * iBit.BitSize, iSizeY * iBit.BitSize, COLOR_3, 0, COLOR_1 );
ClosedMainImage;
for AxisY := 0 to 15 do { *** Draw palette box *** }
for AxisX := 0 to 15 do
Panel( 10 + AxisX * 14, 324 + AxisY * 14, 12, 12, 22, MainPalette^[ AxisX, AxisY ], 31 );
BarDeluxe( 221, 535, 10, 10, PhantomColorStyle, PhantomColor );
Panel(10,552,108,20,22,Color.Foreground,31); {Color of LEFT mouse button}
Panel(124,552,108,20,22,Color.Background,31); {Color of RIGHT mouse button}
(* Panel(280,496,23,18,22,27,31); {Custom color bar of LEFT mouse button}
Panel(280,520,23,18,22,27,31); {Custom color bar of RIGHT mouse button}
*)
(* Panel(276,338,515,21,22,27,31); { Message box }
SetColor(0);
OutTextXY(282,345,'Click here to call closed image operating menu');
*)
{ DRAW IMAGES BLOCK }
for AxisY := 0 to ImagesByY - 1 do
for AxisX := 0 to ImagesByX - 1 do
ImageCage( 276 + AxisX * iSizeX, 58 + AxisY * iSizeY );
{----------------------------}
{DRAW CUSTOM PALETTE BOX}
(*
for AxisY:=1 to 6 do
for AxisX:=1 to 30 do
begin
Panel(296+AxisX*16,480+AxisY*16,14,14,22,COLOR_2,31);
BarDeluxe(297+AxisX*16,481+AxisY*16,12,12,1,27);
end;
*)
{ Status bar }
Panel( 5, 578, GetMaxX - 10, 16, COLOR_3, COLOR_2, COLOR_1 );
Panel( 216, 30, 50, 16, COLOR_3, COLOR_2, COLOR_1 );
{ SetColor( 0 );
SetStandardFont;
OutTextXY( 10, 580, 'Status string of Atomizer' );
}
ShowCurrentImageSize;
end;{of 'DrawDesktop'}
{----------------------------------------------------------------------------}
Procedure MoveImage;
begin
{
Image[ OldSelectImX, OldSelectImY ].Flag := False;
Image[ SelectImX, SelectImY ].Flag := True;
for CntY := 0 to iSizeY - 1 do
for CntX := 0 to iSizeX - 1 do
Clipboard^[ CntX, CntY ] := Image[ SelectImX, SelectImY ].Data^[ CntX + CntY * iSizeY ];
ClosedMainImage;
}
end;
{----------------------------------------------------------------------------}
Procedure LoadCustomPalette;
Var
FileName : String;
F : File;
Color : Byte;
begin
BarDeluxe(0,0,200,20,1,0);
SetColor(10);
OutTextXY(0,10,'Load custom palette:');
ReadLn(FileName);
FileName:=FileName+'.cpf';
Assign(F,FileName);
{$I-}
Reset(F,1);
{$I+}
for AxisY:=0 to 5 do
for AxisX:=0 to 29 do
begin
BlockRead(F,Color,1);
CustPal^[AxisX,AxisY]:=Color;
end;
Close(F);
BarDeluxe(0,0,200,20,1,0);
RefreshCustomPalette;
end;{of 'Load custom palette'}
{----------------------------------------------------------------------------}
Procedure LoadImage;
Var
PalettePresent : Byte;
FileName : String;
Color : Byte;
begin
BarDeluxe(0,0,70,20,1,0);
SetTextStyle(2,0,0);
SetColor(10);
OutTextXY(0,10,'Load image');
ReadLn( FileName );
FileName := FileName + '.agi';
Assign( F, FileName );
{$I-}
Reset( F, 1 );
{$I+}
if IOResult <> 0 then Exit;
BlockRead( F, VERSION_NUMBER, 1 );
BlockRead( F, iSizeX, 1 );
BlockRead( F, iSizeY, 1 );
for AxisY := 0 to iSizeY - 1 do
for AxisX := 0 to iSizeX - 1 do
BlockRead( F, Image[ SelectImX, SelectImY ].Data^[ AxisX + AxisY * iSizeX ], 1 );
{ BlockRead( F, PalettePresent,1);
if PalettePresent=1 then
if PaletteFlag then
begin
for AxisY:=0 to 5 do
for AxisX:=0 to 29 do
begin
BlockRead(F,CustPal^[AxisX,AxisY],1);
end;
RefreshCustomPalette;
end;
}
Close(F);
RefreshCurrentImage;
BarDeluxe(0,0,70,20,1,27);
end;{of 'LoadImage'}
{----------------------------------------------------------------------------}
Procedure LMBOpsWithImages;
begin
{ OldSelectImX := SelectImX;
OldSelectImY := SelectImY;
}
SelectImX := ( m_X_coord - 276 ) div iSizeX;
SelectImY := ( m_Y_coord - 58 ) div iSizeY;
if not Image[ SelectImX, SelectImY ].Flag then { Image now is CLOSED }
ClosedMainImage
else { Image already is OPENED }
begin { Selected other image }
SelectImX := ( m_X_coord - 276 ) div iSizeX;
SelectImY := ( m_Y_coord - 58 ) div iSizeY;
RefreshCurrentImage;
end;
end;
{----------------------------------------------------------------------------}
Procedure OpenNewImage;
Var
ReadPixel : byte;
tmpX : integer;
tmpY : integer;
begin
NewProjectFlag := False;
{ Allocate memory for new image }
Image[ SelectImX, SelectImY ].Flag := True;
GetMem( Image[ SelectImX, SelectImY ].Data, iSizeX * iSizeY );
for tmpY := 0 to iSizeY - 1 do
for tmpX := 0 to iSizeX - 1 do
Image[ SelectImX, SelectImY ].Data^[ tmpX + tmpY * iSizeX ] := Color.Background;
RefreshCurrentImage;
BarDeluxe( 276 + SelectImX * iSizeX, 58 + SelectImY * iSizeY, iSizeX - 1, iSizeY - 1, 1, Color.Background );
{OutTextXY( 400,400, inttostr());}
end;{ of 'OpenNewImage' }
{----------------------------------------------------------------------------}
Procedure Operation;
Var
StartX : Integer;
StartY : Integer;
tmpX : integer;
tmpY : integer;
begin
case OpName of
{---------------------------------------------------------}
Copy : { Copy image to clipboard }
begin
for tmpY := 0 to iSizeY - 1 do
for tmpX := 0 to iSizeX - 1 do
Clipboard^[ tmpX, tmpY ] := Image[ SelectImX, SelectImY ].Data^[ tmpX + tmpY * iSizeY ];
end;
{---------------------------------------------------------}
Paste : { Paste image from clipboard }
begin
StartX := 276 + SelectImX * iSizeX;
StartY := 58 + SelectImY * iSizeY;
if Image[ SelectImX, SelectImY ].Flag = False then { Closed }
begin
Image[ SelectImX, SelectImY ].Flag := True; { Open }
GetMem( Image[ SelectImX, SelectImY ].Data, iSizeX * iSizeY );
end;
for tmpY := 0 to iSizeY - 1 do
for tmpX := 0 to iSizeX - 1 do
begin
PutPixel( StartX + tmpX, StartY + tmpY, Clipboard^[ tmpX, tmpY ] );
Image[ SelectImX, SelectImY ].Data^[ tmpX + tmpY * iSizeX ] := Clipboard^[ tmpX, tmpY ];
end;
Image[ SelectImX, SelectImY ].Flag := True;
RefreshCurrentImage;
end;
{---------------------------------------------------------}
Put : { Put image with transparency }
begin
StartX := 276 + SelectImX * iSizeX;
StartY := 58 + SelectImY * iSizeY;
if Image[ SelectImX, SelectImY ].Flag = False then { Closed }
begin
Image[ SelectImX, SelectImY ].Flag := True; { Open }
GetMem( Image[ SelectImX, SelectImY ].Data, iSizeX * iSizeY );
end;
for tmpY := 0 to iSizeY - 1 do
for tmpX := 0 to iSizeX - 1 do
begin
if Clipboard^[ tmpX, tmpY ] <> PhantomColorNum then { Not phantom }
PutPixel( StartX + tmpX, StartY + tmpY, Clipboard^[ tmpX, tmpY ] );
{if Image[ SelectImX, SelectImY ].Flag = True then
if Image[ SelectImX, SelectImY ].Flag = True then
Image[ SelectImX, SelectImY ].Data^[ CntX + CntY * iSizeX ] := Clipboard^[ CntX, CntY ];
else }
Image[ SelectImX, SelectImY ].Data^[ tmpX + tmpY * iSizeX ] := Clipboard^[ tmpX, tmpY ];
end;
Image[ SelectImX, SelectImY ].Flag := True;
RefreshCurrentImage;
end;
end;
end;
{----------------------------------------------------------------------------}
Procedure PasteImage;
Var
StartX : Integer;
StartY : Integer;
tmpX : integer;
tmpY : integer;
begin
StartX := 276 + SelectImX * iSizeX;
StartY := 58 + SelectImY * iSizeY;
Image[ SelectImX, SelectImY ].Flag := True;
GetMem( Image[ SelectImX, SelectImY ].Data, iSizeX * iSizeY );
for tmpY := 0 to iSizeY - 1 do
for tmpX := 0 to iSizeX - 1 do
begin
PutPixel( StartX + tmpX, StartY + tmpY, Clipboard^[ tmpX, tmpY ] );
Image[ SelectImX, SelectImY ].Data^[ tmpX + tmpY * iSizeX ] := Clipboard^[ tmpX, tmpY ];
end;
Image[ SelectImX, SelectImY ].Flag := True;
RefreshCurrentImage;
end;
{----------------------------------------------------------------------------}
Procedure PutIcon;
Var
IconSizeX : Byte;
IconSizeY : Byte;
Pixel : Byte;
begin
Assign(F,IconName+'.agi');
{$i-}
Reset(F,1);
{$i+}
if IOResult <>0 then Exit;
BlockRead(F,VERSION_NUMBER,1);
BlockRead(F,IconSizeX,1);
BlockRead(F,IconSizeY,1);
for AxisY:=0 to IconSizeY-1 do
for AxisX:=0 to IconSizeX-1 do
begin
BlockRead(F,Pixel,1);
PutPixel(PosX+AxisX,PosY+AxisY,Pixel);
end;
Close(F);
end;{of 'PutIcon'}
{----------------------------------------------------------------------------}
Procedure PutSpinner;
begin
Panel(SpinX,SpinY,28,18,COLOR_3,COLOR_1,28);
PutIcon(SpinX+30,SpinY,PATH_TO_SHELL+'spininc0');
PutIcon(SpinX+30,SpinY+10,PATH_TO_SHELL+'spindec0');
end;
{----------------------------------------------------------------------------}
Procedure RefreshCustomPalette;
Var
Color : Byte;
begin
for AxisY:=0 to 5 do
for AxisX:=0 to 29 do
begin
Color:=CustPal^[AxisX,AxisY];
if Color<>PhantomColorNum then BarDeluxe(313+AxisX*16,497+AxisY*16,12,12,1,Color)
else BarDeluxe(313+AxisX*16,497+AxisY*16,12,12,PhantomColorStyle,PhantomColor);
end;
end;{of 'RefreshCustomPalette'}
{----------------------------------------------------------------------------}
Procedure RefreshCurrentImage;
Var
Color : Byte;
begin
{ Delete lines when open new image }
SetColor( 0 );
Line( 11, 59, 11 + iSizeX * iBit.BitSize - 2, 59 + iSizeY * iBit.BitSize - 2 );
Line( 11 + iSizeX * iBit.BitSize - 2 , 59, 11, 59 + iSizeY * iBit.BitSize - 2 );
for AxisY := 0 to iSizeY - 1 do
for AxisX := 0 to iSizeX - 1 do
begin
Color := Image[ SelectImX, SelectImY ].Data^[ AxisX + AxisY * iSizeX ];
if Color = PhantomColorNum then
BarDeluxe( 11 + AxisX * iBit.BitSize , 59 + AxisY * iBit.BitSize,
iBit.BitSize - 2, iBit.BitSize - 2,
PhantomColorStyle, PhantomColor )
else
BarDeluxe( 11 + AxisX * iBit.BitSize,59 + AxisY * iBit.BitSize,
iBit.BitSize - 2, iBit.BitSize - 2,
1, Color );
end;
end;{of 'RefreshCurrentImage'}
{----------------------------------------------------------------------------}
Procedure RMBOpsWithImages;
begin
OldSelectImX := SelectImX;
OldSelectImY := SelectImY;
SelectImX := ( m_X_coord - 276 ) div iSizeX;
SelectImY := ( m_Y_coord - 58 ) div iSizeY;
if not Image[ SelectImX, SelectImY ].Flag then { Image now is CLOSED }
begin
case VerticalGraphMenu( m_X_coord, m_Y_coord, MENU_ITEM_LIST_ClosedImage, MENU_MAXITEMS_ClosedImage ) of
0 : OpenNewImage;
2 : Operation( Paste );
3 : Operation( Put );
end { of case }
end
else { Image already is OPENED }
if ( OldSelectImX = SelectImX ) and ( OldSelectImY = SelectImY ) then
{ Selected current image }
begin
case VerticalGraphMenu(m_X_coord,m_Y_coord,MENU_ITEM_LIST_OpenedImage,MENU_MAXITEMS_OpenedImage) of
0 : OpenNewImage; { NEW image }
1 : begin end;
2 : begin end;
3 : CloseImage;
5 : Operation( Copy );
6 : Operation( Paste );
7 : Operation( Put );
8 : MoveImage;
end;{ of case }
end;
end;
{----------------------------------------------------------------------------}
Procedure SaveCustomPalette;
Var
FileName : String;
F : File;
Color : Byte;
begin
BarDeluxe(0,0,200,20,1,0);
SetColor(10);
OutTextXY(0,10,'Save custom palette:');
ReadLn(FileName);
FileName:=FileName+'.cpf';
Assign(F,FileName);
Rewrite(F,1);
for AxisY:=0 to 5 do
for AxisX:=0 to 29 do
begin
Color:=CustPal^[AxisX,AxisY];
BlockWrite(F,Color,1);
end;
Close(F);
BarDeluxe(0,0,200,20,1,0);
end;{of 'Save custom palette'}
{----------------------------------------------------------------------------}
Procedure SaveImage;
Var
FileName : String;
DefaultFilename : Byte;
PalettePresent : Byte;
begin
BarDeluxe(0,0,70,20,1,0);
SetColor(10);
SetTextStyle(2,0,0);
OutTextXY(0,10,'Save image');
{ if PaletteFlag then OutTextXY(0,10,'Save image with palette:') else
OutTextXY(0,10,'Save image:');}
ReadLn( FileName );
FileName := FileName + '.agi';
Assign( F, FileName );
Rewrite( F, 1 );
BlockWrite( F, VERSION_NUMBER, 1 );
BlockWrite( F, iSizeX, 1 );
BlockWrite( F, iSizeY, 1 );
for AxisY := 0 to ISizeY - 1 do
for AxisX := 0 to ISizeX - 1 do
BlockWrite( F, Image[ SelectImX, SelectImY ].Data^[ AxisX + AxisY * iSizeX ], 1 );
{
if PaletteFlag then
begin
PalettePresent:=1;
BlockWrite(F,PalettePresent,1);
for AxisY:=0 to 5 do
for AxisX:=0 to 29 do
begin
BlockWrite(F,CustPal^[AxisX,AxisY],1);
end;
end
else
begin
PalettePresent:=0;
BlockWrite(F,PalettePresent,1);
end;
}
Close(F);
BarDeluxe(0,0,70,20,1,27);
end;{of 'SaveImage'}
{----------------------------------------------------------------------------}
Procedure ShowCurrentImageBit;
begin
{SetStandardFont;}
SetColor( COLOR_2 );
OutTextXY( 222, 32, IntToStr( OldImageCageX ) );
OutTextXY( 244, 32, IntToStr( OldImageCageY ) );
OldImageCageX := ImageCageX;
OldImageCageY := ImageCageY;
ImageCageX := ( m_X_coord - 11 ) div iBit.BitSize + 1;
ImageCageY := ( m_Y_coord - 59 ) div iBit.BitSize + 1;
SetColor( 0 );
OutTextXY( 222, 32, IntToStr( OldImageCageX ) );
OutTextXY( 244, 32, IntToStr( OldImageCageY ) );
end;{of 'ShowCurrentImageBit'}
{----------------------------------------------------------------------------}
Procedure ShowCurrentImageSize;
begin
{SetStandardFont;}
SetColor( 0 );
OutTextXY( 10, 580, 'Image: ' );
OutTextXY( 45, 580, IntToStr( iSizeX ) );
OutTextXY( 65, 580, 'x' );
OutTextXY( 73, 580, IntToStr( iSizeY ) );
end;{of 'ShowCurrentImageSize'}
{----------------------------------------------------------------------------}
Procedure SetNewProject;
Const
WinWidth = 160;
WinHeight = 185;
begin
PutIcon(280,32,PATH_TO_SHELL+'newprj0');
CreateWindow(WinCoordX,WinCoordY,WinWidth,WinHeight,'New project');
Area(WinCoordX+10,WinCoordY+40,140,90,'Image Size');
{SetStandardFont;}
SetColor(0);
OutTextXY(WinCoordX+25,WinCoordY+65,'Horizontal');
OutTextXY(WinCoordX+25,WinCoordY+95,'Vertical');
PutSpinner(WinCoordX+90,WinCoordY+62);
PutSpinner(WinCoordX+90,WinCoordY+92);
InitButton(WinCoordX+10,WinCoordY+150,65,20,'OK',OK);
InitButton(WinCoordX+85,WinCoordY+150,65,20,'Cancel',Cancel);
end;
{----------------------------------------------------------------------------}
End.{ of unit 'Service' written by Sergeant at 26.03.99 }