compact format for copy/paste

This commit is contained in:
ronaldhordijk 2005-06-05 16:56:08 +00:00
parent f73c95edec
commit 11a7b08bc3
3 changed files with 74 additions and 18 deletions

View File

@ -9,6 +9,7 @@
+ Added form to modify the image after rendering.
+ B1199407 'Use current' gradient option bug
+ Add zoom out functionality on main form
+ compact format for copy/paste
2.02g
+ Delphi2005 Project

View File

@ -2,7 +2,7 @@ object MainForm: TMainForm
Left = 411
Top = 128
Width = 574
Height = 575
Height = 595
Caption = 'Apophysis'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
@ -27,7 +27,7 @@ object MainForm: TMainForm
Left = 160
Top = 28
Width = 4
Height = 474
Height = 514
end
object ToolBar: TToolBar
Left = 0
@ -261,7 +261,7 @@ object MainForm: TMainForm
Left = 0
Top = 28
Width = 160
Height = 474
Height = 514
Align = alLeft
Columns = <
item
@ -280,7 +280,7 @@ object MainForm: TMainForm
Left = 164
Top = 28
Width = 402
Height = 474
Height = 514
Align = alClient
BevelInner = bvLowered
BevelOuter = bvNone
@ -291,7 +291,7 @@ object MainForm: TMainForm
Left = 1
Top = 1
Width = 400
Height = 472
Height = 492
Align = alClient
AutoSize = True
PopupMenu = DisplayPopup
@ -303,7 +303,7 @@ object MainForm: TMainForm
end
object StatusBar: TStatusBar
Left = 0
Top = 502
Top = 542
Width = 566
Height = 19
Panels = <
@ -321,7 +321,7 @@ object MainForm: TMainForm
Left = 8
Top = 56
Bitmap = {
494C010133003600040010001000FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600
494C010133003600040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
000000000000360000002800000040000000E0000000010020000000000000E0
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
@ -2173,7 +2173,8 @@ object MainForm: TMainForm
C003000F80018000C003000780018000C003000380018000C003000180018000
C003000180018000C003001F80018000C003001F80018001C003001F80018001
C0038FF180018001C007FFF980018001C00FFF7580018001C01FFF8F80018001
C03FFFFF80018001FFFFFFFFFFFFFFFF}
C03FFFFF80018001FFFFFFFFFFFFFFFF00000000000000000000000000000000
000000000000}
end
object SmallImages: TImageList
Left = 40

View File

@ -1288,8 +1288,37 @@ begin
end;
end;
function ColorToXmlCompact(cp1: TControlPoint): string;
var
i: integer;
begin
Result := ' <colors count="256" data="';
function FlameToXML(const cp1: TControlPoint; sheep: boolean): string;
for i := 0 to 255 do begin
Result := Result + IntToHex(0,2)
+ IntToHex(cp1.cmap[i, 0],2)
+ IntToHex(cp1.cmap[i, 1],2)
+ IntToHex(cp1.cmap[i, 2],2);
end;
Result := Result + '"/>';
end;
function ColorToXml(cp1: TControlPoint): string;
var
i: integer;
begin
Result := '';
for i := 0 to 255 do begin
Result := Result + ' <color index="' + IntToStr(i) +
'" rgb="' + IntToStr(cp1.cmap[i, 0]) + ' ' +
IntToStr(cp1.cmap[i, 1]) + ' ' +
IntToStr(cp1.cmap[i, 2]) + '"/>' + #13#10;
end;
end;
function FlameToXML(const cp1: TControlPoint; sheep: boolean; compact: boolean = false): string;
var
t, i, j: integer;
FileList: TStringList;
@ -1348,14 +1377,12 @@ begin
end;
end;
{ Write palette data }
if not sheep then
for i := 0 to 255 do
begin
FileList.Add(' <color index="' + IntToStr(i) +
'" rgb="' + IntToStr(cp1.cmap[i, 0]) + ' ' +
IntToStr(cp1.cmap[i, 1]) + ' ' +
IntToStr(cp1.cmap[i, 2]) + '"/>');
if not sheep then begin
if not compact then
FileList.Add(ColorToXml(cp1));
FileList.Add(ColorToXmlcompact(cp1));
end;
FileList.Add('</flame>');
result := FileList.text;
finally
@ -3610,7 +3637,7 @@ procedure TMainForm.mnuCopyClick(Sender: TObject);
var
txt: string;
begin
txt := Trim(FlameToXML(Maincp, false));
txt := Trim(FlameToXML(Maincp, false, true));
Clipboard.SetTextBuf(PChar(txt));
mnuPaste.enabled := true;
btnPaste.enabled := true;
@ -3912,6 +3939,29 @@ begin
end;
end;
procedure ParseCompactcolors(cp: TControlPoint; count: integer; data: string);
function HexChar(c: Char): Byte;
begin
case c of
'0'..'9': Result := Byte(c) - Byte('0');
'a'..'f': Result := (Byte(c) - Byte('a')) + 10;
'A'..'F': Result := (Byte(c) - Byte('A')) + 10;
else
Result := 0;
end;
end;
var
i: integer;
begin
Assert(Count = 256,'only 256 color Colormaps are supported at the moment');
Assert((Count * 8) = Length(data),'Data size MisMatch');
for i := 0 to Count -1 do begin
Parsecp.cmap[i][0] := 16 * HexChar(Data[i*8 + 3]) + HexChar(Data[i*8 + 4]);
Parsecp.cmap[i][1] := 16 * HexChar(Data[i*8 + 5]) + HexChar(Data[i*8 + 6]);
Parsecp.cmap[i][2] := 16 * HexChar(Data[i*8 + 7]) + HexChar(Data[i*8 + 8]);
end;
end;
procedure TMainForm.XMLScannerEmptyTag(Sender: TObject; TagName: string;
Attributes: TAttrList);
var
@ -3978,6 +4028,10 @@ begin
Parsecp.cmap[i][1] := StrToInt(Tokens[1]);
Parsecp.cmap[i][2] := StrToInt(Tokens[2]);
end;
if TagName = 'colors' then
begin
ParseCompactcolors(Parsecp, StrToInt(Attributes.value('count')), Attributes.value('data'));
end;
if TagName = 'symmetry' then
begin
i := StrToInt(Attributes.value('kind'));