// included by graphics.pp
{******************************************************************************
                                     TPixmap
 ******************************************************************************
 
 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.LCL, included in this distribution,                 *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

{-------------------------------------------------------------------------------
  function XPMToPPChar
  Params: const XPM: string
  Result: PPChar
  
  Converts the source of an XPM image file into an array of PChar.
  The memory is allocated as one block, so freeing can simply be done via
  FreeMem(TheResult). The data is just behind the array.
  
  An XPM file can be included by a C source file, because it has a C syntax.
  In the compiled program it is simply an array of PChar.
  This function converts an XPM source file to the same array, by removing the
  comments and the string constant symbols.
-------------------------------------------------------------------------------}
function XPMToPPChar(const XPM: string): PPChar;
var
  TrimmedXPM: string;
  SrcLen, SrcPos, DestPos, LineCount, CurLine, LineLen: integer;
  LineStart: PChar;
begin
  // trim all comments and symbols and extract only the xpm data between ""
  SrcLen:=length(XPM);
  SetLength(TrimmedXPM,SrcLen+1); // +1 because TrimmedXPM should be at least
                                  // one byte
  SrcPos:=1;
  DestPos:=1;
  LineCount:=1;
  while (SrcPos<=SrcLen) do begin
    case XPM[SrcPos] of

    '/':
      begin
        if (SrcPos<SrcLen) and (XPM[SrcPos+1]='*') then begin
          // this is a C comment
          // -> skip comment
          inc(SrcPos,2);
          while (SrcPos<SrcLen) do begin
            if (XPM[SrcPos]='*') and (XPM[SRcPos+1]='/') then begin
              // comment end found
              inc(SrcPos,2);
              break;
            end;
            inc(SrcPos);
          end;
        end;
      end;

    '"':
      begin
        // start of a string constant
        inc(SrcPos);
        while (SrcPos<SrcLen) do begin
          if XPM[SrcPos]='\' then
            inc(SrcPos);
          if (XPM[SrcPos]='"') and (XPM[SrcPos-1]<>'\') then begin
            // string end found
            inc(SrcPos);
            break;
          end;
          // copy char
          TrimmedXPM[DestPos]:=XPM[SrcPos];
          inc(DestPos);
          inc(SrcPos);
        end;
      end;

    ',':
      begin
        // new string constant
        // -> add #0 char
        inc(SrcPos);
        TrimmedXPM[DestPos]:=#0;
        inc(DestPos);
        inc(LineCount);
      end;

    else
      inc(SrcPos);
    end;
  end;
  TrimmedXPM[DestPos]:=#0; // DestPos now contains the length of trimmed data

  // create array of PChar + image data
  GetMem(Result,SizeOf(PChar)*(LineCount+1)+DestPos);

  // copy data
  Move(TrimmedXPM[1],Result[LineCount+1],DestPos);

  // calculate the array of PChar
  LineStart:=@Result[LineCount+1];
  for CurLine:=0 to LineCount-1 do begin
    LineLen:=StrLen(LineStart)+1;
    Result[CurLine]:=LineStart;
    inc(LineStart,LineLen);
  end;
  Result[LineCount]:=nil; // mark the end of the array with a nil
end;

{-------------------------------------------------------------------------------
  function LazResourceXPMToPPChar
  Params: const ResourceName: string
  Result: PPChar

  Loads the source of an XPM image file from the LazarusResources into an array
  of PChar.
  See XPMToPPChar for more info.
-------------------------------------------------------------------------------}
function LazResourceXPMToPPChar(const ResourceName: string): PPChar;
var XPMSource: TLResource;
begin
  XPMSource:=LazarusResources.Find(ResourceName);
  if XPMSource.ValueType<>'XPM' then
    raise Exception.Create('LazResourceXPMToPPChar: The resource "'
                           +ResourceName+'" is not of type XPM');
  Result:=XPMToPPChar(XPMSource.Value);
end;


{ TPixmap }

procedure TPixmap.LoadFromLazarusResource(const ResName: String);
var
  ms:TMemoryStream;
  res:TLResource;
begin
  res:=LazarusResources.Find(ResName);
  if (res<>nil) and (res.Value<>'') and (res.ValueType='XPM') then begin
    ms:=TMemoryStream.Create;
    try
      ms.Write(res.Value[1],length(res.Value));
      ms.Position:=0;
      LoadFromStream(ms);
    finally
      ms.Free;
    end;
  end;
end;

procedure TPixmap.LoadFromResourceName(Instance: THandle; const ResName: String);
begin
end;

procedure TPixmap.LoadFromResourceID(Instance: THandle; ResID: Integer);
begin
end;

procedure TPixmap.ReadStream(Stream: TStream; Size: Longint);
type
  TCharArray = array[0..0] of PChar;
  PCharArray = ^TCharArray;
var
  Buf: PCharArray;
  BufPtr: ^PChar;
  i, j, LineCount, PixLen, Line3Start, LineStart, LineEnd: Integer;
  s : String;
  
  procedure ParseDataLine;
  var a: integer;
  begin
    if s[LineStart]<>'"' then exit;
    a:=LineStart+1;
    while (a<LineEnd) and (s[a]<>'"') do inc(a);
    if a>=LineEnd then exit;
    s[LineEnd]:=#0;
    BufPtr^ := @s[LineStart+1];
    Inc(BufPtr);
  end;
  
begin
  FreeContext;

  // Convert a XPM filedata format to a XPM memory format
  // by filling an array of PChar with the contents between 
  // the ""'s in the file

  // read stream into string
  PixLen:=Stream.Size;
  if PixLen=0 then exit;
  SetLength(s,PixLen);
  Stream.Read(s[1],PixLen);
  // count line ends
  Line3Start:=-1;
  LineCount:=1;
  i:=1;
  while (i<=PixLen) do begin
    if not (s[i] in [#10,#13]) then
      inc(i)
    else begin
      inc(LineCount);
      inc(i);
      if (i<=PixLen) and (s[i] in [#10,#13]) and (s[i]<>s[i-1]) then
        inc(i);
      if (LineCount=3) and (i<PixLen) then Line3Start:=i;
    end;
  end;
  if (s[PixLen] in [#10,#13]) then dec(LineCount);
  // build PChar Array of Data-Line Starts ( " characters)
  if (LineCount>2) and (Line3Start>=1) and (s[Line3Start]='"') then begin
    Buf := GetMem((LineCount+1) * SizeOf(PCharArray));
    try
      BufPtr := Pointer(Buf);
      LineStart:=1;
      i:=1;
      while (i<=PixLen) do begin
        if not (s[i] in [#10,#13]) then
          inc(i)
        else begin
          // found line end
          LineEnd:=i;
          ParseDataLine;
          inc(i);
          if (i<=PixLen) and (s[i] in [#10,#13]) and (s[i]<>s[i-1]) then
            inc(i);
          LineStart:=i;
        end;
      end;
      if not (s[PixLen] in [#10,#13]) and (LineStart<=PixLen) then begin
        LineEnd:=PixLen+1;
        ParseDataLine;
      end;
      BufPtr^ := nil;
      // Create the pixmap
      if FTransparentColor = clNone then
        // create a transparent pixmap (with mask)
        Handle := CreatePixmapIndirect(Buf, -1)
      else
        // create an opaque pixmap.
        // Transparent pixels are filled with FTransparentColor
        Handle := CreatePixmapIndirect(Buf, ColorToRGB(FTransparentColor));

      // set width and height
      // the third line is of the form '"<width as decimal> <height as decimal> '
      LineEnd:=Line3Start;
      while (LineEnd<PixLen) and not (s[LineEnd] in [#13,#10]) do inc(LineEnd);
      i:=Line3Start+1; // ignore initial "
      j:=i;
      while (j<LineEnd) and (s[j]<>' ') do inc(j);
      FWidth := StrToIntDef(copy(s,i,j-i),1);
      inc(j);
      i:=j;      
      while (j<LineEnd) and (s[j]<>' ') do inc(j);
      FHeight := StrToIntDef(copy(s,i,j-i),1);
    finally
      FreeMem(Buf);
    end;
  end;
end;

// included by graphics.pp

{ =============================================================================

  $Log$
  Revision 1.13  2002/06/08 17:16:02  lazarus
  MG: added close buttons and images to TNoteBook and close buttons to source editor

  Revision 1.12  2002/05/10 06:05:55  lazarus
  MG: changed license to LGPL

  Revision 1.11  2001/09/30 08:34:50  lazarus
  MG: fixed mem leaks and fixed range check errors

  Revision 1.10  2001/06/26 00:08:36  lazarus
  MG: added code for form icons from Rene E. Beszon

  Revision 1.9  2001/06/06 12:30:41  lazarus
  MG: bugfixes

  Revision 1.8  2001/03/19 14:40:49  lazarus
  MG: fixed many unreleased DC and GDIObj bugs

  Revision 1.6  2001/02/04 18:24:41  lazarus
  Code cleanup
  Shane

  Revision 1.5  2001/01/04 16:12:54  lazarus
  Removed some writelns and changed the property editor for TStrings a bit.
  Shane

  Revision 1.4  2001/01/03 18:44:54  lazarus
  The Speedbutton now has a numglyphs setting.
  I started the TStringPropertyEditor

  Revision 1.3  2000/12/29 20:32:33  lazarus
  Speedbuttons can now draw disabled images.
  Shane

  Revision 1.2  2000/07/30 21:48:32  lazarus
  MWE:
    = Moved ObjectToGTKObject to GTKProc unit
    * Fixed array checking in LoadPixmap
    = Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
    ~ Some cleanup

  Revision 1.1  2000/07/13 10:28:27  michael
  + Initial import

  Revision 1.2  2000/05/09 02:07:40  lazarus
  Replaced writelns with Asserts.                          CAW

  Revision 1.1  2000/04/02 20:49:56  lazarus
  MWE:
    Moved lazarus/lcl/*.inc files to lazarus/lcl/include

  Revision 1.2  2000/03/17 17:07:00  lazarus
  Added images to speedbuttons
  Shane

  Revision 1.1  2000/03/17 13:21:29  lazarus
  MWE:
    Forgot to add inc.


}