{"id":1131,"date":"2014-04-22T22:00:12","date_gmt":"2014-04-22T21:00:12","guid":{"rendered":"http:\/\/tulip-ui.azurewebsites.net\/?page_id=1131"},"modified":"2014-04-22T23:20:17","modified_gmt":"2014-04-22T22:20:17","slug":"tulip-ui-utils-pas","status":"publish","type":"page","link":"https:\/\/tulip-ui.azurewebsites.net\/?page_id=1131","title":{"rendered":"Tulip.UI.Utils.pas"},"content":{"rendered":"<div style=\"background-color: #FFFFFF; width: 680px\">\n<p style=\"text-align: right;\"><a title=\"Source Files\" href=\"http:\/\/tulip-ui.azurewebsites.net\/?page_id=1091\">Source Files<\/a><\/p>\n<p><code><\/p>\n<pre>\r\n{******************************************************************************}\r\n{                                                                              }\r\n{                        Tulip - User Interface Library                        }\r\n{                                                                              }\r\n{             Copyright(c) 2012 Marcos Gomes. All rights Reserved.             }\r\n{                                                                              }\r\n{  --------------------------------------------------------------------------  }\r\n{                                                                              }\r\n{  This product is based on Asphyre Sphinx (c) 2000 - 2012  Yuriy Kotsarenko.  }\r\n{       All rights reserved. Official web site: http:\/\/www.afterwarp.net       }\r\n{                                                                              }\r\n{******************************************************************************}\r\n{                                                                              }\r\n{  Important Notice:                                                           }\r\n{                                                                              }\r\n{  If you modify\/use this code or one of its parts either in original or       }\r\n{  modified form, you must comply with Mozilla Public License Version 2.0,     }\r\n{  including section 3, \"Responsibilities\". Failure to do so will result in    }\r\n{  the license breach, which will be resolved in the court. Remember that      }\r\n{  violating author's rights either accidentally or intentionally is           }\r\n{  considered a serious crime in many countries. Thank you!                    }\r\n{                                                                              }\r\n{  !! Please *read* Mozilla Public License 2.0 document located at:            }\r\n{  http:\/\/www.mozilla.org\/MPL\/                                                 }\r\n{                                                                              }\r\n{  --------------------------------------------------------------------------  }\r\n{                                                                              }\r\n{  The contents of this file are subject to the Mozilla Public License         }\r\n{  Version 2.0 (the \"License\"); you may not use this file except in            }\r\n{  compliance with the License. You may obtain a copy of the License at        }\r\n{  http:\/\/www.mozilla.org\/MPL\/                                                 }\r\n{                                                                              }\r\n{  Software distributed under the License is distributed on an \"AS IS\"         }\r\n{  basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the     }\r\n{  License for the specific language governing rights and limitations          }\r\n{  under the License.                                                          }\r\n{                                                                              }\r\n{  The Original Code is Tulip.UI.Utils.pas.                                    }\r\n{                                                                              }\r\n{  The Initial Developer of the Original Code is Marcos Gomes.                 }\r\n{  Portions created by Marcos Gomes are Copyright (C) 2012, Marcos Gomes.      }\r\n{  All Rights Reserved.                                                        }\r\n{                                                                              }\r\n{******************************************************************************}\r\n{                                                                              }\r\n{  Tulip.UI.Utils.pas                                   Modified: 05-Out-2012  }\r\n{  --------------------------------------------------------------------------  }\r\n{                                                                              }\r\n{                        Util routines for handling data                       }\r\n{                                                                              }\r\n{                                Version 1.02                                  }\r\n{                                                                              }\r\n{******************************************************************************}\r\n\r\nunit Tulip.UI.Utils;\r\n\r\ninterface\r\n\r\nuses\r\n  System.Classes,\r\n  \/\/ Asphyre\r\n  StreamUtils, SystemSurfaces, AsphyreTypes, AsphyreConv, AsphyreBitmaps,\r\n  AsphyrePNG, AsphyreJPG, AsphyreBMP,\r\n  \/\/ Tulip UI Units\r\n  Tulip.UI.Classes;\r\n{$REGION 'Colors'}\r\nfunction cAlpha4(c: TFillColor): TColor4; overload;\r\nfunction cColor2(c: TTextColor): TColor2; overload;\r\nfunction cColor4(c: TFillColor): TColor4; overload;\r\nfunction cColor4(c: TTextColor): TColor4; overload;\r\n{$ENDREGION}\r\n{$REGION 'Lists'}\r\nprocedure ListAdd(var List: TList; Item: Pointer);\r\nprocedure ListRemove(var List: TList; Item: Pointer);\r\n{$ENDREGION}\r\n{$REGION 'Stream'}\r\nfunction XmlFileToStream(FileName: String; out AStream: TMemoryStream): Boolean;\r\nfunction ImageFileToStream(FileName: String;\r\n  out AStream: TMemoryStream): Boolean;\r\n{$ENDREGION}\r\n\r\nimplementation\r\n\r\n{$REGION 'Colors'}\r\nfunction cAlpha4(c: TFillColor): TColor4;\r\nbegin\r\n  Result[0] := cAlpha1(cGetAlpha1(c.TopLeft));\r\n  Result[1] := cAlpha1(cGetAlpha1(c.TopRight));\r\n  Result[2] := cAlpha1(cGetAlpha1(c.BottomRight));\r\n  Result[3] := cAlpha1(cGetAlpha1(c.BottomLeft));\r\nend;\r\n\r\nfunction cColor2(c: TTextColor): TColor2;\r\nbegin\r\n  Result[0] := c.Top;\r\n  Result[1] := c.Bottom;\r\nend;\r\n\r\nfunction cColor4(c: TFillColor): TColor4;\r\nbegin\r\n  Result[0] := c.TopLeft;\r\n  Result[1] := c.TopRight;\r\n  Result[2] := c.BottomRight;\r\n  Result[3] := c.BottomLeft;\r\nend;\r\n\r\nfunction cColor4(c: TTextColor): TColor4;\r\nbegin\r\n  Result[0] := c.Top;\r\n  Result[1] := c.Top;\r\n  Result[2] := c.Bottom;\r\n  Result[3] := c.Bottom;\r\nend;\r\n{$ENDREGION}\r\n{$REGION 'Lists'}\r\n\r\nprocedure ListAdd(var List: TList; Item: Pointer);\r\nbegin\r\n  if List = nil then\r\n    List := TList.Create;\r\n  List.Add(Item);\r\nend;\r\n\r\nprocedure ListRemove(var List: TList; Item: Pointer);\r\nvar\r\n  Count: Integer;\r\nbegin\r\n  Count := List.Count;\r\n  if Count > 0 then\r\n  begin\r\n    { On destruction usually the last item is deleted first }\r\n    if List[Count - 1] = Item then\r\n      List.Delete(Count - 1)\r\n    else\r\n      List.Remove(Item);\r\n  end;\r\n  if List.Count = 0 then\r\n  begin\r\n    List.Free;\r\n    List := nil;\r\n  end;\r\nend;\r\n{$ENDREGION}\r\n{$REGION 'Stream'}\r\n\r\nfunction XmlFileToStream(FileName: String; out AStream: TMemoryStream): Boolean;\r\nbegin\r\n  Result := False;\r\n\r\n  try\r\n    AStream.LoadFromFile(FileName);\r\n  except\r\n    Exit;\r\n  end;\r\n\r\n  Result := True;\r\nend;\r\n\r\nfunction ImageFileToStream(FileName: String;\r\n  out AStream: TMemoryStream): Boolean;\r\nvar\r\n  AuxMem: Pointer;\r\n  AuxSize: Integer;\r\n  Image: TSystemSurface;\r\n  Index: Integer;\r\nbegin\r\n  Image := TSystemSurface.Create;\r\n\r\n  Result := BitmapManager.LoadFromFile(FileName, Image);\r\n\r\n  if not Result then\r\n  begin\r\n    Image.Free;\r\n    Exit;\r\n  end;\r\n\r\n  \/\/ --> Format\r\n  StreamPutByte(AStream, Byte(apf_A8R8G8B8));\r\n  \/\/ --> Pattern Size\r\n  StreamPutWord(AStream, Image.Width);\r\n  StreamPutWord(AStream, Image.Height);\r\n  \/\/ --> Pattern Count\r\n  StreamPutLongInt(AStream, 1);\r\n  \/\/ --> Visible Size\r\n  StreamPutWord(AStream, Image.Width);\r\n  StreamPutWord(AStream, Image.Height);\r\n  \/\/ --> Texture Size\r\n  StreamPutWord(AStream, Image.Width);\r\n  StreamPutWord(AStream, Image.Height);\r\n  \/\/ --> Texture Count\r\n  StreamPutWord(AStream, 1);\r\n\r\n  \/\/ Allocate auxiliary memory for pixel conversion.\r\n  AuxSize := (Image.Width * AsphyrePixelFormatBits[apf_A8R8G8B8]) div 8;\r\n  AuxMem := AllocMem(AuxSize);\r\n\r\n  \/\/ Convert pixel data and write it to the stream.\r\n  try\r\n    for Index := 0 to Image.Height - 1 do\r\n    begin\r\n      Pixel32toXArray(Image.ScanLine[Index], AuxMem, apf_A8R8G8B8, Image.Width);\r\n      AStream.WriteBuffer(AuxMem^, AuxSize);\r\n    end;\r\n  except\r\n    FreeMem(AuxMem);\r\n    Image.Free;\r\n\r\n    Result := False;\r\n    Exit;\r\n  end;\r\n\r\n  \/\/ Release auxiliary memory.\r\n  FreeMem(AuxMem);\r\n  Image.Free;\r\n\r\n  \/\/ position to the beginning of our stream\r\n  AStream.Seek(0, soFromBeginning);\r\n\r\n  Result := True;\r\nend;\r\n{$ENDREGION}\r\n\r\nend.\r\n<\/pre>\n<p><\/code>\n<\/div>\n","protected":false},"excerpt":{"rendered":"<p>Source Files {******************************************************************************} { } { Tulip &#8211; User Interface Library } { } { Copyright(c) 2012 Marcos Gomes. All rights Reserved. } { } { &#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8211; } { } <a class=\"more-link\" href=\"https:\/\/tulip-ui.azurewebsites.net\/?page_id=1131\">Continue Reading &rarr;<\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"parent":1091,"menu_order":0,"comment_status":"closed","ping_status":"open","template":"","meta":[],"_links":{"self":[{"href":"https:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages\/1131"}],"collection":[{"href":"https:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages"}],"about":[{"href":"https:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"https:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=1131"}],"version-history":[{"count":2,"href":"https:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages\/1131\/revisions"}],"predecessor-version":[{"id":1841,"href":"https:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages\/1131\/revisions\/1841"}],"up":[{"embeddable":true,"href":"https:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages\/1091"}],"wp:attachment":[{"href":"https:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=1131"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}