updates Palette Export support for all languages

rmabout.lfm

@@ -5,8 +5,8 @@ object AboutDialog: TAboutDialog
  Width = 600
  BorderStyle = bsDialog
  Caption = 'About'
- ClientHeight = 313
- ClientWidth = 600
+ ClientHeight = 0
+ ClientWidth = 0
  DesignTimePPI = 120
  LCLVersion = '2.0.10.0'
  object ProgramNameLabel: TLabel

rmabout.pas

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

rmmain.lfm

@@ -4,8 +4,8 @@ object RMMainForm: TRMMainForm
  Top = -9
  Width = 1920
  Caption = 'Raster Master'
- ClientHeight = 0
- ClientWidth = 0
+ ClientHeight = 1026
+ ClientWidth = 1920
  DesignTimePPI = 120
  Menu = MainMenu1
  OnCreate = FormCreate
@@ -575,7 +575,7 @@ object RMMainForm: TRMMainForm
  end
  end
  object TurboBasic: TMenuItem
- Caption = 'Turbo/Power Basic'
+ Caption = 'Turbo\Power Basic'
  object TBPutData: TMenuItem
  Caption = 'Put Data Statements'
  OnClick = TurboPowerBasicClick
@@ -776,6 +776,28 @@ object RMMainForm: TRMMainForm
  OnClick = AmigaPascalPaletteClick
  end
  end
+ object MenuItem3: TMenuItem
+ Caption = 'FreeBASIC'
+ object FBPaletteData: TMenuItem
+ Caption = 'Palette Data Statements'
+ OnClick = PaletteExportQBasicClick
+ end
+ object FBPaletteCommands: TMenuItem
+ Caption = 'Palette Commands'
+ OnClick = PaletteExportQBasicClick
+ end
+ end
+ object MenuItem2: TMenuItem
+ Caption = 'FreePascal'
+ object FPPaletteArray: TMenuItem
+ Caption = 'Palettte Array'
+ OnClick = PaletteExportTurboPascalClick
+ end
+ object FPPaletteCommands: TMenuItem
+ Caption = 'Palette Commands'
+ OnClick = PaletteExportTurboPascalClick
+ end
+ end
  object PaletteExportGWBasic: TMenuItem
  Caption = 'GWBASIC'
  object GWPaletteData: TMenuItem
@@ -809,6 +831,28 @@ object RMMainForm: TRMMainForm
  OnClick = PaletteExportQuickCClick
  end
  end
+ object PaletteExportQuickPascal: TMenuItem
+ Caption = 'QuickPascal'
+ object QPPaletteArray: TMenuItem
+ Caption = 'Palettte Array'
+ OnClick = PaletteExportQuickCClick
+ end
+ object QPPaletteCommands: TMenuItem
+ Caption = 'Palette Commands'
+ OnClick = PaletteExportQuickCClick
+ end
+ end
+ object MenuItem7: TMenuItem
+ Caption = 'Turbo\Power Basic'
+ object PBPaletteData: TMenuItem
+ Caption = 'Palette Data Statements'
+ OnClick = PaletteExportQBasicClick
+ end
+ object PBPaletteCommands: TMenuItem
+ Caption = 'Palette Commands'
+ OnClick = PaletteExportQBasicClick
+ end
+ end
  object PaletteExportTurboC: TMenuItem
  Caption = 'Turbo C'
  object TCPaletteArray: TMenuItem

rmmain.pas

@@ -51,6 +51,18 @@ TRMMainForm = class(TForm)
  GWPutPlusMaskData: TMenuItem;
  GWMouseShapeData: TMenuItem;
  FPMouseShapeArray: TMenuItem;
+ QPPaletteArray: TMenuItem;
+ QPPaletteCommands: TMenuItem;
+ PaletteExportQuickPascal: TMenuItem;
+ PBPaletteCommands: TMenuItem;
+ MenuItem2: TMenuItem;
+ FPPaletteArray: TMenuItem;
+ FPPaletteCommands: TMenuItem;
+ MenuItem3: TMenuItem;
+ FBPaletteData: TMenuItem;
+ FBPaletteCommands: TMenuItem;
+ MenuItem7: TMenuItem;
+ PBPaletteData: TMenuItem;
  QCMouseShapeArray: TMenuItem;
  QPMouseShapeArray: TMenuItem;
  TBMouseShapeData: TMenuItem;
@@ -1979,6 +1991,10 @@ procedure TRMMainForm.PaletteExportQBasicClick(Sender: TObject);
 begin
  Case (Sender As TMenuItem).Name of 'QBPaletteData' : ExportDialog.Filter := 'QuickBasic\QB64 Palette Data|*.bas';
  'QBPaletteCommands' : ExportDialog.Filter :='QuickBasic\QB64 Palette Commands|*.bas';
+ 'FBPaletteData' : ExportDialog.Filter := 'FreeBASIC Palette Data|*.bas';
+ 'FBPaletteCommands' : ExportDialog.Filter :='FreeBASIC Palette Commands|*.bas';
+ 'PBPaletteData' : ExportDialog.Filter := 'Turbo\Power Basic Palette Data|*.bas';
+ 'PBPaletteCommands' : ExportDialog.Filter :='Turbo\Power Basic Palette Commands|*.bas';
  end;
 
  if ExportDialog.Execute then
@@ -1990,6 +2006,10 @@ procedure TRMMainForm.PaletteExportQBasicClick(Sender: TObject);
 
  Case (Sender As TMenuItem).Name of 'QBPaletteData' : error:=WritePalData(ExportDialog.FileName,QBLan,ColorFormat);
  'QBPaletteCommands' : error:=WritePalStatements(ExportDialog.FileName,QBLan,ColorFormat);
+ 'FBPaletteData' : error:=WritePalData(ExportDialog.FileName,FBLan,ColorFormat);
+ 'FBPaletteCommands' : error:=WritePalStatements(ExportDialog.FileName,FBLan,ColorFormat);
+ 'PBPaletteData' : error:=WritePalData(ExportDialog.FileName,PBLan,ColorFormat);
+ 'PBPaletteCommands' : error:=WritePalStatements(ExportDialog.FileName,PBLan,ColorFormat);
  end;
 
  if error<>0 then
@@ -2411,6 +2431,8 @@ procedure TRMMainForm.PaletteExportQuickCClick(Sender: TObject);
  begin
  Case (Sender As TMenuItem).Name of 'QCPaletteArray' : ExportDialog.Filter := 'QuickC Palette Array|*.c';
  'QCPaletteCommands' : ExportDialog.Filter :='QuickC Palette Commands|*.c';
+ 'QPPaletteArray' : ExportDialog.Filter := 'QuickPasca; Palette Array|*.pas';
+ 'QPPaletteCommands' : ExportDialog.Filter :='QuickPascal Palette Commands|*.pas';
  end;
 
  if ExportDialog.Execute then
@@ -2419,10 +2441,13 @@ procedure TRMMainForm.PaletteExportQuickCClick(Sender: TObject);
  ColorFormat:=ColorSixBitFormat;
  if pm=PaletteModeEGA then ColorFormat:=ColorIndexFormat;
 
- Case (Sender As TMenuItem).Name of 'QCPaletteArray' : error:=WritePalData(ExportDialog.FileName,QCLan,ColorFormat);
+ Case (Sender As TMenuItem).Name of 'QCPaletteArray' : error:=WritePalConstants(ExportDialog.FileName,QCLan,ColorFormat);
  'QCPaletteCommands' : error:=WritePalStatements(ExportDialog.FileName,QCLan,ColorFormat);
+ 'QPPaletteArray' : error:=WritePalConstants(ExportDialog.FileName,QPLan,ColorFormat);
+ 'QPPaletteCommands' : error:=WritePalStatements(ExportDialog.FileName,QPLan,ColorFormat);
  end;
 
+
  if error<>0 then
  begin
  ShowMessage('Error Saving Palette file!');
@@ -2443,10 +2468,10 @@ procedure TRMMainForm.PaletteExportTurboCClick(Sender: TObject);
  if ExportDialog.Execute then
  begin
  pm:=RMCoreBase.Palette.GetPaletteMode;
- ColorFormat:=ColorSixBitFormat;
+ ColorFormat:=ColorEightBitFormat;
  if pm=PaletteModeEGA then ColorFormat:=ColorIndexFormat;
 
- Case (Sender As TMenuItem).Name of 'TCPaletteArray' : error:=WritePalData(ExportDialog.FileName,TCLan,ColorFormat);
+ Case (Sender As TMenuItem).Name of 'TCPaletteArray' : error:=WritePalConstants(ExportDialog.FileName,TCLan,ColorFormat);
  'TCPaletteCommands' : error:=WritePalStatements(ExportDialog.FileName,TCLan,ColorFormat);
 
  end;
@@ -2882,15 +2907,19 @@ procedure TRMMainForm.PaletteExportTurboPascalClick(Sender: TObject);
 begin
  Case (Sender As TMenuItem).Name of 'TPPaletteArray' : ExportDialog.Filter := 'Turbo Pascal Palette Array|*.pas';
  'TPPaletteCommands' : ExportDialog.Filter :='Turbo Pascal Palette Commands|*.pas';
+ 'FPPaletteArray' : ExportDialog.Filter := 'FreePascal Palette Array|*.pas';
+ 'FPPaletteCommands' : ExportDialog.Filter :='FreePascal Palette Commands|*.pas';
  end;
  if ExportDialog.Execute then
  begin
- ColorFormat:=ColorSixBitFormat;
+ ColorFormat:=ColorEightBitFormat;
  pm:=RMCoreBase.Palette.GetPaletteMode;
  if (pm=PaletteModeEGA) then ColorFormat:=ColorIndexFormat;
 
  Case (Sender As TMenuItem).Name of 'TPPaletteArray' : error:=WritePalConstants(ExportDialog.FileName,TPLan,ColorFormat);
  'TPPaletteCommands' : error:=WritePalStatements(ExportDialog.FileName,TPLan,ColorFormat);
+ 'FPPaletteArray' : error:=WritePalConstants(ExportDialog.FileName,FPLan,ColorFormat);
+ 'FPPaletteCommands' : error:=WritePalStatements(ExportDialog.FileName,FPLan,ColorFormat);
  end;
 
  if error<>0 then

rwpal.pas

@@ -77,20 +77,20 @@ function LanToStr(Lan: integer) : string;
  QBLan:LanToStr:='QuickBASIC';
  QCLan:LanToStr:='QuickC';
  QPLan:LanToStr:='QuickPascal';
- FBLan:LanToStr:='Freebasic';
- FPLan:LanToStr:='Freepascal';
+ FBLan:LanToStr:='FreeBASIC';
+ FPLan:LanToStr:='FreePascal';
 
  end;
 end;
 
 function PaletteCmdToStr(Lan,ColorFormat : integer) : string;
 begin
  PaletteCmdToStr:='Palette';
- if (Lan=TPLan) and (ColorFormat=ColorIndexFormat) then
+ if ((Lan=TPLan) OR (Lan=FPLan)) and (ColorFormat=ColorIndexFormat) then
  begin
  PaletteCmdToStr:='SetPalette(';
  end
- else if (Lan=TPLan) then
+ else if (Lan=TPLan) OR (Lan=FPLan) then
  begin
  PaletteCmdToStr:='SetRGBPalette(';
  end
@@ -105,7 +105,16 @@ function PaletteCmdToStr(Lan,ColorFormat : integer) : string;
  else if (Lan=QCLan) then
  begin
  PaletteCmdToStr:='_remappalette(';
+ end
+ else if (Lan=QPLan) then
+ begin
+ PaletteCmdToStr:='_RemapPalette(';
+ end
+ else if (Lan=PBLan) and (ColorFormat=ColorSixBitFormat) then //Turbo/PB do not support additional palette information for VGA rgb formula
+ begin //maybe in future will replacement function for PB
+ PaletteCmdToStr:='PaletteX';
  end;
+
 end;
 
 function LineTrmToStr(Lan : integer) : string;
@@ -127,11 +136,18 @@ function CommentBeginToStr(Lan : integer) : string;
 function CommentEndToStr(Lan : integer) : string;
 begin
  CommentEndToStr:='';
- Case Lan of TPLan,FPLan,APLan:CommentEndToStr:='*)';
+ Case Lan of QPLan,TPLan,FPLan,APLan:CommentEndToStr:='*)';
  TCLan,QCLan,ACLan:CommentEndToStr:='*/';
  end;
 end;
 
+function CommandEndBracketToStr(Lan : integer) : string;
+begin
+ CommandEndBracketToStr:=');';
+ Case Lan of ABLan,FBLan,QBlan,PBLan,GWLan:CommandEndBracketToStr:='';
+ end;
+end;
+
 
 
 function FileNameToPaletteName(filename : string) : string;
@@ -160,19 +176,14 @@ function WritePalData(filename : string; Lan,rgbFormat : integer) : word;
  Writeln(F,LineCountToStr(Lan),CommentBeginToStr(Lan),' ',LanToStr(Lan),' Palette, ',' Size= ',GetPalSize(nColors,rgbFormat),' Colors= ',NColors, 'Format= ',BFormat);
  For i:=0 to NColors-1 do
  begin
- (*
- r:=RMCoreBase.Palette.GetRed(i);
- g:=RMCoreBase.Palette.GetGreen(i);
- b:=RMCoreBase.Palette.GetBlue(i);
-*)
  GetColor(i,CR);
  r:=CR.r;
  g:=CR.g;
  b:=CR.b;
  if rgbFormat = ColorIndexFormat then
  begin
  cistr:=ColorValueToStr(RGBToEGAIndex(r,g,b),rgbFormat);
- WriteLn(F,LineCountToStr(Lan),'DATA ',cistr); //linecounttostr is blank unless js GWLan
+ WriteLn(F,LineCountToStr(Lan),'DATA ',cistr); //linecounttostr is blank unless is GWLan
  end
  else
  begin
@@ -220,7 +231,7 @@ function WritePalConstants(filename : string; Lan,rgbFormat : integer) : word;
  begin
  arraysize:=Ncolors*3-1;
  end;
- If (Lan = TPlan) OR (Lan =FPLan) OR (Lan = APLan) then
+ If (Lan=TPlan) OR (Lan =FPLan) OR (Lan=QPlan) OR (Lan = APLan) then
  begin
  Writeln(F,palettenamestr, ' : array[0..',arraysize,'] of byte = (');
  end
@@ -235,10 +246,6 @@ function WritePalConstants(filename : string; Lan,rgbFormat : integer) : word;
 
  For i:=0 to NColors-1 do
  begin
-(* r:=RMCoreBase.Palette.GetRed(i);
- g:=RMCoreBase.Palette.GetGreen(i);
- b:=RMCoreBase.Palette.GetBlue(i);
- *)
  GetColor(i,CR);
  r:=CR.r;
  g:=CR.g;
@@ -297,21 +304,17 @@ function WritePalStatements(filename : string; Lan,rgbFormat : integer) : word;
  NColors:=GetMaxColor+1;
  BFormat:=ColorFormatToStr(rgbFormat);
  pcmdstr:=PaletteCmdToStr(Lan,rgbFormat);
- LineTrmStr:=LineTrmToStr(Lan);
+ LineTrmStr:=CommandEndBracketToStr(Lan);
 // LineCounter:=1000;
  Writeln(F,LineCountToStr(Lan),CommentBeginToStr(Lan),' ',LanToStr(Lan),' Palette Commands, ',' Size= ',GetPalSize(nColors,rgbFormat),' Colors= ',NColors,' Format=',BFormat,' ',CommentEndToStr(Lan));
  For i:=0 to NColors-1 do
  begin
-(* r:=RMCoreBase.Palette.GetRed(i);
- g:=RMCoreBase.Palette.GetGreen(i);
- b:=RMCoreBase.Palette.GetBlue(i);
-*)
  GetColor(i,CR);
  r:=CR.r;
  g:=CR.g;
  b:=CR.b;
 
- if (Lan=QBLan) and (rgbFormat = ColorSixBitFormat) then
+ if ((Lan=QBLan) or (Lan=FBLan) or (Lan=GWLan) or (Lan=PBLan) or (Lan=QCLan) or (Lan=QPLan)) and (rgbFormat = ColorSixBitFormat) then
  begin
  cistr:=IntToStr(EightToSixBit(r)+(EightToSixBit(g)*256)+(EightToSixBit(b)*65536));
  WriteLn(F,LineCountToStr(Lan),pcmdstr,' ',i,', ',cistr,LineTrmStr);