DOS Mouse Drive Shape Format

rm.lpi

@@ -130,7 +130,7 @@
  <PackageName Value="LCL"/>
  </Item2>
  </RequiredPackages>
- <Units Count="16">
+ <Units Count="17">
  <Unit0>
  <Filename Value="rm.lpr"/>
  <IsPartOfProject Value="True"/>
@@ -213,6 +213,10 @@
  <Filename Value="rwpng.pas"/>
  <IsPartOfProject Value="True"/>
  </Unit15>
+ <Unit16>
+ <Filename Value="wmouse.pas"/>
+ <IsPartOfProject Value="True"/>
+ </Unit16>
  </Units>
  </ProjectOptions>
  <CompilerOptions>

rmabout.pas

@@ -8,7 +8,7 @@ interface
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,lclintf;
 
 Const
- ProgramName ='Raster Master v1.0 Beta R39';
+ ProgramName ='Raster Master v1.0 Beta R40';
  ProgramLicense = 'Released under MIT License';
 
 type

rmmain.lfm

@@ -4,8 +4,8 @@ object RMMainForm: TRMMainForm
  Top = -9
  Width = 1920
  Caption = 'Raster Master'
- ClientHeight = 1026
- ClientWidth = 1920
+ ClientHeight = 0
+ ClientWidth = 0
  DesignTimePPI = 120
  Menu = MainMenu1
  OnCreate = FormCreate
@@ -463,6 +463,10 @@ object RMMainForm: TRMMainForm
  Caption = 'Put File'
  OnClick = FreeBASICClick
  end
+ object FBMouseShapeData: TMenuItem
+ Caption = 'Mouse Shape Data Statements'
+ OnClick = MouseSaveClick
+ end
  end
  object FreePascal: TMenuItem
  Caption = 'FreePascal'
@@ -478,6 +482,10 @@ object RMMainForm: TRMMainForm
  Caption = 'PutImage File'
  OnClick = FreePascalClick
  end
+ object FPMouseShapeArray: TMenuItem
+ Caption = 'Mouse Shape Array'
+ OnClick = MouseSaveClick
+ end
  end
  object GWBASIC: TMenuItem
  Caption = 'GWBASIC'
@@ -493,6 +501,10 @@ object RMMainForm: TRMMainForm
  Caption = 'Put File'
  OnClick = GWBASICClick
  end
+ object GWMouseShapeData: TMenuItem
+ Caption = 'Mouse Shape Data Statements'
+ OnClick = MouseSaveClick
+ end
  end
  object JavaScript: TMenuItem
  Caption = 'JavaScript'
@@ -519,6 +531,10 @@ object RMMainForm: TRMMainForm
  Caption = 'Put File'
  OnClick = QBasicDataClick
  end
+ object QBMouseShapeData: TMenuItem
+ Caption = 'Mouse Shape Data Statements'
+ OnClick = MouseSaveClick
+ end
  end
  object QuickC: TMenuItem
  Caption = 'Quick C'
@@ -534,6 +550,10 @@ object RMMainForm: TRMMainForm
  Caption = '_putimage File'
  OnClick = QuickCClick
  end
+ object QCMouseShapeArray: TMenuItem
+ Caption = 'Mouse Shape Array'
+ OnClick = MouseSaveClick
+ end
  end
  object QuickPascal: TMenuItem
  Caption = 'Quick Pascal'
@@ -549,6 +569,10 @@ object RMMainForm: TRMMainForm
  Caption = 'PutImage File'
  OnClick = QuickPascalClick
  end
+ object QPMouseShapeArray: TMenuItem
+ Caption = 'Mouse Shape Array'
+ OnClick = MouseSaveClick
+ end
  end
  object TurboBasic: TMenuItem
  Caption = 'Turbo/Power Basic'
@@ -564,6 +588,10 @@ object RMMainForm: TRMMainForm
  Caption = 'Put File'
  OnClick = TurboPowerBasicClick
  end
+ object TBMouseShapeData: TMenuItem
+ Caption = 'Mouse Shape Data Statements'
+ OnClick = MouseSaveClick
+ end
  end
  object TurboPascal: TMenuItem
  Caption = 'Turbo Pascal'
@@ -579,6 +607,10 @@ object RMMainForm: TRMMainForm
  Caption = 'PutImage File'
  OnClick = TurboPascalClick
  end
+ object TPMouseShapeArray: TMenuItem
+ Caption = 'Mouse Shape Array'
+ OnClick = MouseSaveClick
+ end
  object TPDOSLBMArray: TMenuItem
  Caption = 'DOS Xlib LBM Array'
  OnClick = TurboPascalClick
@@ -610,6 +642,10 @@ object RMMainForm: TRMMainForm
  Caption = 'putimage File'
  OnClick = TurboCClick
  end
+ object TCMouseShapeArray: TMenuItem
+ Caption = 'Mouse Shape Array'
+ OnClick = MouseSaveClick
+ end
  object TCDOSLBMArray: TMenuItem
  Caption = 'DOS Xlib LBM Array'
  OnClick = TurboCClick

rmmain.pas

@@ -9,7 +9,7 @@ interface
  StdCtrls, ComCtrls, Menus, ActnList, StdActns, ColorPalette, Types,
  LResources,lclintf, rmtools, rmcore,rmcolor,rmcolorvga,rmamigaColor,
  rmabout,rwpal,rwraw,rwpcx,rwbmp,rwxgf,wcon,flood,rmamigarwxgf,wjavascriptarray,rmthumb,
- wmodex,rwgif,rwxgf2,rmexportprops,rres,rwpng;
+ wmodex,rwgif,rwxgf2,rmexportprops,rres,rwpng,wmouse;
 
 
 type
@@ -49,6 +49,15 @@ TRMMainForm = class(TForm)
  FBPutPlusMaskData: TMenuItem;
  FPPutImagePlusMaskArray: TMenuItem;
  GWPutPlusMaskData: TMenuItem;
+ GWMouseShapeData: TMenuItem;
+ FPMouseShapeArray: TMenuItem;
+ QCMouseShapeArray: TMenuItem;
+ QPMouseShapeArray: TMenuItem;
+ TBMouseShapeData: TMenuItem;
+ QBMouseShapeData: TMenuItem;
+ TCMouseShapeArray: TMenuItem;
+ FBMouseShapeData: TMenuItem;
+ TPMouseShapeArray: TMenuItem;
  TCPutImagePlusMaskArray: TMenuItem;
  TBPutPlusMaskData: TMenuItem;
  QPPutImagePlusMaskArray: TMenuItem;
@@ -248,6 +257,8 @@ TRMMainForm = class(TForm)
  procedure PaletteEditColors(Sender: TObject);
  procedure PropertiesClick(Sender: TObject);
  procedure QuickPascalClick(Sender: TObject);
+ procedure MouseSaveClick(Sender: TObject);
+
 
  procedure RESExportClick(Sender: TObject);
  procedure SaveDeleteClick(Sender: TObject);
@@ -2890,6 +2901,71 @@ procedure TRMMainForm.PaletteExportTurboPascalClick(Sender: TObject);
  end;
 end;
 
+procedure TRMMainForm.MouseSaveClick(Sender: TObject);
+var
+ x,y,x2,y2 : integer;
+ pm : integer;
+ error : word;
+ validpm : boolean;
+ mwidth : integer;
+ mheight : integer;
+begin
+ GetOpenSaveRegion(x,y,x2,y2);
+ mwidth:=x2-x+1;
+ mheight:=y2-y+1;
+
+ pm:=RMCoreBase.Palette.GetPaletteMode;
+ validpm:=(pm=PaletteModeCGA0) OR (pm=PaletteModeCGA1) OR (pm=PaletteModeAmiga4);
+ if validpm = false then
+ begin
+ ShowMessage('Invalid Mode for Mouse Shape. Choose a Palette mode with 4 colors!');
+ exit;
+ end;
+
+ if (mwidth<>16) OR (mheight<>16) then
+ begin
+ ShowMessage('Mouse Shape Width and Height should be 16 pixels!');
+ exit;
+ end;
+
+ Case (Sender As TMenuItem).Name of 'QBMouseShapeData',
+ 'FBMouseShapeData',
+ 'TBMouseShapeData',
+ 'GWMouseShapeData' : ExportDialog.Filter := 'Basic Mouse Shape Data Statements|*.bas';
+ 'TPMouseShapeArray',
+ 'QPMouseShapeArray',
+ 'FPMouseShapeArray' : ExportDialog.Filter := 'Pascal Mouse Shape Array|*.pas';
+ 'TCMouseShapeArray',
+ 'QCMouseShapeArray' : ExportDialog.Filter := 'C Mouse Shape Array|*.c';
+ end;
+
+
+
+ if ExportDialog.Execute then
+ begin
+ Case (Sender As TMenuItem).Name of 'QBMouseShapeData',
+ 'FBMouseShapeData',
+ 'TBMouseShapeData': error:=WriteMShapeToCode(x,y,QBLan,ExportDialog.FileName);
+ 'GWMouseShapeData': error:=WriteMShapeToCode(x,y,GWLan,ExportDialog.FileName);
+ 'TPMouseShapeArray',
+ 'QPMouseShapeArray': error:=WriteMShapeToCode(x,y,TPLan,ExportDialog.FileName);
+ 'TCMouseShapeArray',
+ 'QCMouseShapeArray': error:=WriteMShapeToCode(x,y,TCLan,ExportDialog.FileName);
+ end;
+
+
+
+
+ if error<>0 then
+ begin
+ ShowMessage('Error Saving file!');
+ exit;
+ end;
+ end;
+
+end;
+
+
 procedure TRMMainForm.EditCopyClick(Sender: TObject);
 var
  x,y,x2,y2 : integer;

rwpal.pas

@@ -132,14 +132,7 @@ function CommentEndToStr(Lan : integer) : string;
  end;
 end;
 
-function LineCountToStr(Lan : integer) : string;
-begin
- LineCountToStr:='';
- if (lan=GWLan) then
- begin
- LineCountToStr:=GetGWNextLineNumber+' ';
- end;
-end;
+
 
 function FileNameToPaletteName(filename : string) : string;
 begin

rwxgf2.pas

@@ -103,10 +103,13 @@
 
  procedure SetGWStartLineNumber(start : integer);
  function GetGWNextLineNumber : string;
+ function LineCountToStr(Lan : integer) : string;
 
 procedure BitplaneWriterFile(inByte : Byte; var Buffer : BufferRec;action : integer);
 procedure BitplaneWriterPascalCode(inByte : Byte; var Buffer : BufferRec;action : integer);
 procedure BitplaneWriterCCode(inByte : Byte; var Buffer : BufferRec;action : integer);
+procedure BitplaneWriterBasicCode(inByte : Byte; var Buffer : BufferRec;action : integer);
+procedure BitplaneWriterGWBasicCode(inByte : Byte; var Buffer : BufferRec;action : integer);
 
 Implementation
 
@@ -607,6 +610,16 @@ function GetGWNextLineNumber : string;
  inc(GWBasicLineNumber,10);
 end;
 
+
+function LineCountToStr(Lan : integer) : string;
+begin
+ LineCountToStr:='';
+ if (lan=GWLan) then
+ begin
+ LineCountToStr:=GetGWNextLineNumber+' ';
+ end;
+end;
+
 procedure BitplaneWriterGWBasicCode(inByte : Byte; var Buffer : BufferRec;action : integer);
 var
  i : integer;
@@ -995,6 +1008,7 @@ procedure WriteXgfToBufferFP(x,y,x2,y2,Mask : word;var data : BufferRec);
  imagename : String;
 begin
  SetCoreActive; // we are getting data from core object RMCoreBase
+ SetGWStartLineNumber(1000);
  assign(data.fText,filename);
 {$I-}
  rewrite(data.fText);