working on it ...

Filters

snippets
544
followers
7
Published by snip2code

Pascal

This channel collects useful snippets for Pascal language
Sort by

Found 544 snippets

    public by snip2code modified Aug 13, 2017  396  3  4  0

    First Snippet: How to play with Snip2Code

    This is the first example of a snippet: - the title represents in few words which is the exact issue the snippet resolves; it can be something like the name of a method; - the description (this field) is an optional field where you can add interesting information regarding the snippet; something like the comment on the head of a method; - the c
    /* place here the actual content of your snippet. 
       It should be code or pseudo-code. 
       The less dependencies from external stuff, the better! */

    public by FMXExpress modified Nov 13, 2014  9220  92  7  1

    Non Blocking Message Dialog For Delphi XE7 Firemonkey

    MessageDlg(‘Do you want to press yes or no?’, System.UITypes.TMsgDlgType.mtInformation,
      [System.UITypes.TMsgDlgBtn.mbYes, System.UITypes.TMsgDlgBtn.mbNo], 0,
        procedure(const AResult: TModalResult)
        begin
          case AResult of
            { Detect which button was pushed and show a different message }
            mrYes:
                begin
                // pressed yes
                end;
            mrNo:
                begin
                // pressed no
                end;
          end;
        end
      );
    // code here would get executed right away

    public by FMXExpress modified Nov 12, 2014  7395  9  9  4

    Install A Shortcut On Android With Delphi XE5 Firemonkey

    http://www.fmxexpress.com/install-shortcuts-on-the-android-home-screen-with-delphi-xe5-firemonkey/
    //Android permission required:
    //<uses-permission android:name=”com.android.launcher.permission.INSTALL_SHORTCUT”/>
        
    Uses
    Androidapi.JNI.GraphicsContentViewText, FMX.Helpers.Android,
    Androidapi.JNI.JavaTypes, FMX.Platform.Android, AndroidApi.JniBridge, AndroidApi.Jni.App,
    AndroidAPI.jni.OS;
    
    {$IFDEF ANDROID}
    var
    ShortcutIntent: JIntent;
    addIntent: JIntent;
    wIconIdentifier : integer;
    wIconResource : JIntent_ShortcutIconResource;
    {$ENDIF}
    begin
    {$IFDEF ANDROID}
    
    ShortcutIntent := TJIntent.JavaClass.init(SharedActivityContext, SharedActivityContext.getClass);
    ShortcutIntent.setAction(TJIntent.JavaClass.ACTION_MAIN);
    
    addIntent := TJIntent.Create;
    addIntent.putExtra(TJIntent.JavaClass.EXTRA_SHORTCUT_INTENT, TJParcelable.Wrap((shortcutIntent as ILocalObject).GetObjectID));// here we need to cast the intent as it’s not done in delphi by default, not like java
    addIntent.putExtra(TJIntent.JavaClass.EXTRA_SHORTCUT_NAME, StringToJString(Application.Title));
    addIntent.setAction(StringToJString(‘com.android.launcher.action.INSTALL_SHORTCUT’));
    // get icon resource identifier
    wIconIdentifier := SharedActivity.getResources.getIdentifier(StringToJString(‘ic_launcher’), StringToJString(‘drawable’), StringToJString(‘com.embarcadero.HeaderFooterApplication’)); // if the app name change, you must change the package name
    wIconResource := TJIntent_ShortcutIconResource.JavaClass.fromContext(SharedActivityContext, wIconIdentifier);
    // set icon for shortcut
    addIntent.putExtra(TJIntent.JavaClass.EXTRA_SHORTCUT_ICON_RESOURCE, TJParcelable.Wrap((wIconResource as ILocalObject).GetObjectID));
    
    SharedActivityContext.sendBroadcast(addIntent);
    
    {$ENDIF}
     

    public by FMXExpress modified Nov 12, 2014  4388  20  6  1

    Decode GZIP Content From TRESTClient In Delphi XE7 Firemonkey

    RESTClient.AcceptEncoding := 'gzip, deflate';
    RESTClient.Execute;
    
    if RESTResponse.ContentEncoding=’gzip’ then
    DecodeGZIPContent(RESTResponse.RawBytes) // decode and do something with the content
    else
    RESTResponse.Content; // do something with the content
    
    function DecodeGZIPContent(RawBytes: System.TArray<System.Byte>): String;
    var
    MSI: TMemoryStream;
    MSO: TStringStream;
    begin
    MSI := TMemoryStream.Create;
    MSO := TStringStream.Create;
    MSI.WriteData(RawBytes,Length(RawBytes));
    MSI.Seek(0,0);
    // Zlib is a TIdCompressorZlib
    Zlib.DecompressGZipStream(MSI,MSO);
    MSI.DisposeOf;
    MSO.Seek(0,0);
    Result := MSO.DataString;
    MSO.Free;
    end;

    public by FMXExpress modified Nov 12, 2014  4796  2  7  1

    Process Strings Using A Parallel For Loop In Delphi XE7 Firemonkey

    TParallel.For(0,1000,
     procedure(I: Integer)
      begin
       TThread.Queue(TThread.CurrentThread,
        procedure
         begin
          Memo1.Lines.Append(I.ToString);
         end);
      end);

    external by Michalis Kamburelis modified Feb 19, 2018  7  0  1  0

    Test TCastleImageControl

    Test TCastleImageControl: testing_img.lpr
    uses CastleControls, CastleWindow, CastleFilesUtils, CastleColors;
    var
      Window: TCastleWindowCustom;
      Bg: TCastleSimpleBackground;
      Image: TCastleImageControl;
    begin
      Window := TCastleWindowCustom.Create(Application);
      Window.Open;
    
      Bg := TCastleSimpleBackground.Create(Application);
      Bg.Color := Yellow;
      Window.Controls.InsertFront(Bg);
    
      Image := TCastleImageControl.Create(Application);
      Image.URL := ApplicationData('Input.png');
      Window.Controls.InsertFront(Image);
    
      Application.Run;
    end.
    
    
    

    external by Github modified Feb 16, 2018  6  0  1  0

    dosya açıklaması

    dosya açıklaması: dosya_adi.pas
    Türkçe içerik
    
    

    external by freeonterminate modified Feb 7, 2018  9  0  1  0

    TStringGrid をソートするサンプルコード

    TStringGrid をソートするサンプルコード: PK.StringGrid.Helper.pas
    (*
     * TStringGrid をソートするサンプルコード
     *
     * Copyright (c) 2018 HOSOKAWA Jun.
     *
     * HOW TO USE:
     *   1. Add PK.StringGrid.Helper to uses block.
     *   2. Call StringGrid.SortByColumn(Column)
     *
     * EXAMPLE:
     *   uses
     *     PK.StringGrid.Helper;
     *
     *   procedure TForm1.FormCreate(Sender: TObject);
     *   begin
     *     StringGrid1.RowCount := 4;
     *
     *     StringGrid1.Cells[0, 0] := '222';
     *     StringGrid1.Cells[0, 1] := '333';
     *     StringGrid1.Cells[0, 2] := '111';
     *     StringGrid1.Cells[0, 3] := '000';
     *
     *     StringGrid1.Cells[1, 0] := 'ddd';
     *     StringGrid1.Cells[1, 1] := 'ccc';
     *     StringGrid1.Cells[1, 2] := 'aaa';
     *     StringGrid1.Cells[1, 3] := 'bbb';
     *
     *     StringGrid1.Cells[2, 0] := 'DDD';
     *     StringGrid1.Cells[2, 1] := 'BBB';
     *     StringGrid1.Cells[2, 2] := 'CCC';
     *     StringGrid1.Cells[2, 3] := 'AAA';
     *   end;
     *
     *   procedure TForm1.StringGrid1HeaderClick(Column: TColumn);
     *   begin
     *     StringGrid1.SortByColumn(Column);
     *   end;
     *
     * LICENSE:
     *   本ソフトウェアは「現状のまま」で、明示であるか暗黙であるかを問わず、
     *   何らの保証もなく提供されます。
     *   本ソフトウェアの使用によって生じるいかなる損害についても、
     *   作者は一切の責任を負わないものとします。
     *
     *   以下の制限に従う限り、商用アプリケーションを含めて、本ソフトウェアを
     *   任意の目的に使用し、自由に改変して再頒布することをすべての人に許可します。
     *
     *   1. 本ソフトウェアの出自について虚偽の表示をしてはなりません。
     *      あなたがオリジナルのソフトウェアを作成したと主張してはなりません。
     *      あなたが本ソフトウェアを製品内で使用する場合、製品の文書に謝辞を入れて
     *      いただければ幸いですが、必須ではありません。
     *
     *   2. ソースを変更した場合は、そのことを明示しなければなりません。
     *      オリジナルのソフトウェアであるという虚偽の表示をしてはなりません。
     *
     *   3. ソースの頒布物から、この表示を削除したり、表示の内容を変更したりしては
     *      なりません。
     *
     *   This software is provided 'as-is', without any express or implied warranty.
     *   In no event will the authors be held liable for any damages arising from
     *   the use of this software.
     *
     *   Permission is granted to anyone to use this software for any purpose,
     *   including commercial applications, and to alter it and redistribute
     *   it freely, subject to the following restrictions:
     *
     *   1. The origin of this software must not be misrepresented;
     *      you must not claim that you wrote the original software.
     *      If you use this software in a product, an acknowledgment in the product
     *      documentation would be appreciated but is not required.
     *
     *   2. Altered source versions must be plainly marked as such,
     *      and must not be misrepresented as being the original software.
     *
     *   3. This notice may not be removed or altered from any source distribution.
     *)
    
    unit PK.StringGrid.Helper;
    
    interface
    
    uses
      FMX.Grid;
    
    type
      TStringGridHelper = class helper for TStringGrid
      public
        procedure SortByColumnNo(const iCol: Integer);
        procedure SortByColumn(const iColumn: TColumn);
      end;
    
    implementation
    
    uses
      System.SysUtils;
    
    { TStringGridHelper }
    
    procedure TStringGridHelper.SortByColumnNo(const iCol: Integer);
    
      procedure QuickSort(iLo, iHi: Integer);
      var
        Min, Max, Mid: Integer;
        tmpStr: String;
        i: Integer;
      begin
        repeat
          Min := iLo;
          Max := iHi;
          Mid := (iLo + iHi) shr 1;
    
          repeat
            while CompareStr(Cells[iCol, Min], Cells[iCol, Mid]) < 0 do
              Inc(Min);
    
            while CompareStr(Cells[iCol, Max], Cells[iCol, Mid]) > 0 do
              Dec(Max);
    
            if (Min <= Max) then
            begin
              for i := 0 to ColumnCount - 1 do
              begin
                tmpStr := Cells[i, Min];
                Cells[i, Min] := Cells[i, Max];
                Cells[i, Max] := tmpStr;
              end;
    
              if (Mid = Min) then
                Mid := Max
              else if (Mid = Max) then
                Mid := Min;
    
              Inc(Min);
              Dec(Max);
            end;
          until (Min > Max);
    
          if (iLo < Max) then
            QuickSort(iLo, Max);
    
          iLo := Min;
        until (Min >= iHi);
      end;
    
    begin
      QuickSort(0, RowCount - 1);
    end;
    
    procedure TStringGridHelper.SortByColumn(const iColumn: TColumn);
    var
      Col: Integer;
      i: Integer;
    begin
      // ソート元になるコラムを探す
      Col := -1;
      for i := 0 to ColumnCount - 1 do
        if (Columns[i] = iColumn) then
        begin
          Col := i;
          Break;
        end;
    
      if (Col < 0) then
        Exit;
    
      SortByColumnNo(Col);
    end;
    
    end.
    
    

    external by unilecs modified Feb 2, 2018  7  0  1  0

    Задача 66: Степень двойки (@jinxonik)

    Задача 66: Степень двойки (@jinxonik): GetN.pas
    {$APPTYPE CONSOLE}
    //{$DEFINE ENTERLEN}
    const
      HugeNumber = 1E4000;
    
    var
    {$IFNDEF ENTERLEN}
      SourceStr: String;
    {$ENDIF}
      Power, SourceLen, CurValLen, TotalLen: Integer;
      CurValue, ControlVal: Extended;
    
    begin
    {$IFNDEF ENTERLEN}
      Write('Enter source string: ');
      ReadLn(SourceStr);
      SourceLen := Length(SourceStr);
    {$ELSE}
      Write('Enter source string length: ');
      ReadLn(SourceLen);
    {$ENDIF}
      if SourceLen <= 0 then WriteLn('String is empty!')
      else
      begin
        Power := 1;
        CurValLen := 1;
        TotalLen := 1;
        CurValue := 2;
        ControlVal := 10;
        while TotalLen < SourceLen do
        begin
          CurValue := CurValue * 2;
          if CurValue >= ControlVal then
          begin
            Inc(CurValLen);
            if ControlVal >= HugeNumber then
            begin
              CurValue := CurValue / HugeNumber;
              ControlVal := ControlVal / HugeNumber;
            end;
            ControlVal := ControlVal * 10;
          end;
          Inc(Power);
          Inc(TotalLen, CurValLen);
        end;
        WriteLn('Power of last number is ', Power, ' (last power value length is ', CurValLen, ' digits)');
      end;
    end.
    
    

    external by coyoteelabs modified Jan 28, 2018  17  0  1  0

    Delphi unit to add support for Targa images

    Delphi unit to add support for Targa images: TargaImage.pas
    unit TargaImage;
    {**************
     * MIT License
     **************}
    
    interface
    
    uses
      WinApi.Windows, System.SysUtils, System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.ClipBrd, System.AnsiStrings;
    
    var
      Color16to24: array[0..31] of Byte = (0, 8, 16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112,
                                           120, 128, 136, 144, 152, 160, 168, 176, 184, 192, 200, 208,
                                           216, 224, 232, 240, 248);
    const
    
    NO_COLORMAP_INCLUDED = 0;
    COLORMAP_IS_INCLUDED = 1;
    
    NO_IMAGEDATA_INCLUDED = 0;
    COLORMAPPED_IMAGE = 1;
    TRUECOLOR_IMAGE = 2;
    BLACKANDWHITE_IMAGE = 3;
    RLE_COLORMAPPED_IMAGE = 9;
    RLE_TRUECOLOR_IMAGE = 10;
    RLE_BLACKANDWHITE_IMAGE = 11;
    
    CF_TARGA = 20;
    
    type
    TMouseLeaveEvent = procedure(Sender: TObject) of object;
    TMouseEnterEvent = procedure(Sender: TObject) of object;
    
    TTargaID = packed record
      Length: Byte;
      Text: PAnsiChar;
      end;
    
    TTargaColorMapSpec = packed record
      FirstEntryIndex: Word;
      ColorMapLength: Word;
      ColorMapEntrySize: Byte;
      end;
    
    TTargaImageDescriptor = packed record
      AlphaChannelBits: Byte;
      Top: Boolean;
      Left: Boolean;
      end;
    
    TTargaImageSpec = packed record
      X: Word;
      Y: Word;
      Width: Word;
      Height: Word;
      PixelDepth: Byte;
      ImageDescriptor: TTargaImageDescriptor;
      end;
    
    TRGBA = packed record
      Red: Byte;
      Green: Byte;
      Blue: Byte;
      Alpha: Byte;
      end;
    
    TColorMap = packed array[0..999] of TRGBA;
    
    TTargaType = (ttNoImageData, ttColorMapedImage, ttTrueColorImage, ttBlackAndWhiteImage, ttRLEColorMapedImage,
                  ttRLETrueColorImage, ttRLEBlackAndWhiteImage);
    
    TTargaViewType = (tvBitmap, tvAlphaChannel, tvUseAlphaChannel);
    
    TTargaColorDepthType = (cd8bit, cd16bit, cd24bit, cd32bit);
    
    TTargaClipboardType = (ctTarga, ctBitmap, ctAlphaChannel);
    
    type
       TTarga = class(TGraphic)
       private
        FColorDepth: TTargaColorDepthType;
        FColorMapType: Byte;
        FColorMap: TColorMap;
        FColorMapSpec: TTargaColorMapSpec;
        FID: TTargaID;
        FImage: string;
        FImageType: Byte;
        FImageSpec: TTargaImageSpec;
        FIncludeAlphaChannel: Boolean;
        FTargaType: TTargaType;
        FOnChange: TNotifyEvent;
        FBitmap: TBitmap;
        FAlphaChannel: TBitmap;
        procedure ChangeBitmap(Sender: TObject);
        procedure SetBitmap(Value: TBitmap);
        procedure SetAlphaChannel(Value: TBitmap);
        function RLEDecompress(DataLength: Integer; var RLEBuffer: PAnsiChar; var Buffer: PAnsiChar): Integer;
        function RLECompress(DataLength: Integer; var RLEBuffer: PAnsiChar; var Buffer: PAnsiChar): Integer;
       protected
        procedure Changed(Sender: TObject); override;
        procedure DefineProperties(Filer: TFiler); override;
        procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
        function GetEmpty: Boolean; override;
        function GetHeight: Integer; override;
        function GetWidth: Integer; override;
        procedure ReadData(Stream: TStream); override;
        procedure SetHeight(Value: Integer); override;
        procedure SetWidth(Value: Integer); override;
        procedure WriteData(Stream: TStream); override;
       public
        constructor Create; override;
        destructor Destroy; override;
        procedure LoadFromResourceName(Instance: THandle; const ResName: String);
        procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
        procedure LoadFromFile(const FileName: string); override;
        procedure LoadFromStream(Stream: TStream); override;
        procedure LoadFromClipboardFormat(Format: Word; Data: THandle; Palette: HPALETTE); override;
        procedure LoadFromClipboard(LoadType: TTargaClipboardType);
        procedure SaveToFile(const FileName: string); override;
        procedure SaveToStream(Stream: TStream); override;
        procedure SaveToClipboardFormat(var Format: Word; var Data: THandle; var Palette: HPALETTE); override;
        procedure SaveToClipboard(SaveType: TTargaClipboardType);
        procedure Assign(Source: TPersistent); override;
        property OnChange: TNotifyEvent read FOnChange write FOnChange;
        property Bitmap: TBitmap read FBitmap write SetBitmap;
        property AlphaChannel: TBitmap read FAlphaChannel write SetAlphaChannel;
       end;
    
    implementation
    
    procedure Register;
    begin
      TPicture.RegisterFileFormat('tga', 'Targa image', TTarga);
      TPicture.RegisterClipboardFormat(CF_TARGA, TTarga);
    end;
    
    function Right(Text: string; Count: Word): string;
    begin
      Result:=Copy(Text,Length(Text)-(Count-1),Count);
    end;
    
    constructor TTarga.Create;
    begin
      inherited Create;
      FBitmap:=TBitmap.Create;
      FBitmap.PixelFormat:=pf32bit;
      FBitmap.OnChange:=ChangeBitmap;
      FAlphaChannel:=TBitmap.Create;
      FAlphaChannel.PixelFormat:=pf32bit;
      FAlphaChannel.OnChange:=ChangeBitmap;
    end;
    
    destructor TTarga.Destroy;
    begin
      FBitmap.Free;
      FAlphaChannel.Free;
      inherited Destroy;
    end;
    
    procedure TTarga.ChangeBitmap(Sender: TObject);
    begin
      FBitmap.PixelFormat:=pf32bit;
      FAlphaChannel.PixelFormat:=pf32bit;
    end;
    
    procedure TTarga.Changed(Sender: TObject);
    begin
      if Assigned(FOnChange) then FOnChange(self);
      inherited Changed(Sender);
    end;
    
    procedure TTarga.DefineProperties(Filer: TFiler);
    
      function DoWrite: Boolean;
        begin
        if Filer.Ancestor <> nil then
          Result := not (Filer.Ancestor is TGraphic) or
            not Equals(TGraphic(Filer.Ancestor))
        else
          Result := not Empty;
        end;
    
    begin
      Filer.DefineBinaryProperty('Data', ReadData, WriteData, DoWrite);
    end;
    
    procedure TTarga.LoadFromFile(const FileName: string);
    var fsOpen: TFileStream;
    begin
      fsOpen:=TFileStream.Create(FileName,fmShareDenyWrite);
      try
        LoadFromStream(fsOpen);
      finally
        fsOpen.Free;
        end;
    end;
    
    procedure TTarga.SaveToFile(const FileName: string);
    var fsOpen: TFileStream;
    begin
      if UpperCase(Right(FileName,3))='.BMP' then
        begin
        FBitmap.SaveToFile(FileName);
        end
      else
        begin
        fsOpen:=TFileStream.Create(FileName,fmCreate);
        try
          SaveToStream(fsOpen);
        finally
          fsOpen.Free;
          end;
        end;
    end;
    
    procedure TTarga.Draw(ACanvas: TCanvas; const Rect: TRect);
    begin
      StretchBlt(ACanvas.Handle, Rect.Left, Rect.Top, Rect.Right - Rect.Left,
                 Rect.Bottom - Rect.Top, FBitmap.Canvas.Handle, 0, 0, FBitmap.Width, FBitmap.Height, ACanvas.CopyMode);
    end;
    
    procedure TTarga.ReadData(Stream: TStream);
    var CName: string[63];
        tmpVersion: array[0..1] of Char;
    begin
      Stream.Read(CName[0], 1);
      Stream.Read(CName[1], Integer(CName[0]));
      if Assigned(Stream) then
      begin
        Stream.Read(tmpVersion, 2);
        Stream.Seek(-2, soFromCurrent);
        if tmpVersion = 'BM' then
          Bitmap.LoadFromStream(Stream)
        else
          inherited ReadData(Stream);
      end;
    end;
    
    procedure TTarga.WriteData(Stream: TStream);
    var CName: string[63];
    begin
      with Stream do
        begin
        CName := ClassName;
        Write(CName, Length(CName) + 1);
        end;
      FTargaType:=ttTrueColorImage;
      FColorDepth:=cd32bit;
      SaveToStream(Stream);
    end;
    
    procedure TTarga.SetBitmap(Value: TBitmap);
    begin
      if FBitmap <> Value then
      begin
        FBitmap.Assign(Value);
        if Assigned(FOnChange) then FOnChange(self);
      end;
    end;
    
    procedure TTarga.SetAlphaChannel(Value: TBitmap);
    begin
      if FAlphaChannel <> Value then
      begin
        FAlphaChannel.Assign(Value);
        if Assigned(FOnChange) then FOnChange(self);
      end;
    end;
    
    function TTarga.GetEmpty: Boolean;
    begin
      Result := FBitmap.Empty;
    end;
    
    function TTarga.GetHeight: Integer;
    begin
      Result:=FImageSpec.Height;
    end;
    
    function TTarga.GetWidth: Integer;
    begin
      Result:=FImageSpec.Width;
    end;
    
    procedure TTarga.SetHeight(Value: Integer);
    begin
    end;
    
    procedure TTarga.SetWidth(Value: Integer);
    begin
    end;
    
    procedure TTarga.Assign(Source: TPersistent);
    begin
      if Source is TTarga then
        begin
        FBitmap.Assign(TTarga(Source).FBitmap);
        FAlphaChannel.Assign(TTarga(Source).FAlphaChannel);
        end
      else
        inherited Assign(Source);
    end;
    
    procedure TTarga.LoadFromResourceName(Instance: THandle; const ResName: String);
    var
      Stream: TResourceStream;
    begin
      Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA);
      try
        LoadFromStream(Stream);
      finally
        Stream.Free;
      end;
    end;
    
    procedure TTarga.LoadFromResourceID(Instance: THandle; ResID: Integer);
    var
      Stream: TResourceStream;
    begin
      Stream := TResourceStream.CreateFromID(Instance, ResID, RT_RCDATA);
      try
        LoadFromStream(Stream);
      finally
        Stream.Free;
      end;
    end;
    
    procedure TTarga.LoadFromStream(Stream: TStream);
    var Buffer: PAnsiChar;
        RLEBuffer: PAnsiChar;
        i, j: Integer;
        Color16: Word;
        LineSize: Integer;
        LineBuffer, AlphaBuffer: PByteArray;
        tmp16: Word;
        ReadLength: Integer;
    
      procedure GetBAWImageType(IsRLE: Boolean);
        var i, j: Integer;
        begin
        FColorDepth:=cd8bit;
        FIncludeAlphaChannel:=False;
        if IsRLE then FTargaType:=ttRLEBlackAndWhiteImage else FTargaType:=ttBlackAndWhiteImage;
        if IsRLE then RLEBuffer:=AnsiStrAlloc(LineSize*2);
        for i:=0 to FImageSpec.Height-1 do
          begin
          if not FImageSpec.ImageDescriptor.Top and not FImageSpec.ImageDescriptor.Left then
            LineBuffer:=FBitmap.ScanLine[FImageSpec.Height-(i+1)]
          else LineBuffer:=FBitmap.ScanLine[i];
          if IsRLE then
            begin
            ReadLength:=Stream.Read(RLEBuffer^,LineSize*2);
            Stream.Position:=Stream.Position-ReadLength+RLEDecompress(FImageSpec.Width,RLEBuffer, Buffer);
            end
          else Stream.Read(Buffer^,LineSize);
          for j:=0 to FImageSpec.Width-1 do
            begin
            LineBuffer[(j*4)]:=Ord(Buffer[j]);
            LineBuffer[(j*4)+1]:=Ord(Buffer[j]);
            LineBuffer[(j*4)+2]:=Ord(Buffer[j]);
            end;
          end;
        end;
    
    begin
      Buffer:=AnsiStrAlloc(18);
      Stream.Read(Buffer^,18);
      FID.Length:=Ord(Buffer[0]);
      FColorMapType:=Ord(Buffer[1]);
      FImageType:=Ord(Buffer[2]);
      FColorMapSpec.FirstEntryIndex:=Ord(Buffer[3])+Ord(Buffer[4])*256;
      FColorMapSpec.ColorMapLength:=Ord(Buffer[5])+Ord(Buffer[6])*256;
      FColorMapSpec.ColorMapEntrySize:=Ord(Buffer[7]);
      FImageSpec.X:=Ord(Buffer[8])+Ord(Buffer[9])*256;
      FImageSpec.Y:=Ord(Buffer[10])+Ord(Buffer[11])*256;
      FImageSpec.Width:=Ord(Buffer[12])+Ord(Buffer[13])*256;
      FImageSpec.Height:=Ord(Buffer[14])+Ord(Buffer[15])*256;
      FImageSpec.PixelDepth:=Ord(Buffer[16]);
      FImageSpec.ImageDescriptor.AlphaChannelBits:=Ord(Buffer[17]) and 15;
      FImageSpec.ImageDescriptor.Top:=(Ord(Buffer[17]) and 32)=32;
      FImageSpec.ImageDescriptor.Left:=(Ord(Buffer[17]) and 16)=16;
      System.AnsiStrings.StrDispose(Buffer);
      if FID.Length>0 then
        begin
        Stream.Read(Buffer^,FID.Length);
        FID.Text:=Buffer;
        System.AnsiStrings.StrDispose(Buffer);
        end
      else FID.Text:='';
      if FColorMapType=1 then
        begin
        case FColorMapSpec.ColorMapEntrySize of
          15: begin
              Buffer:=AnsiStrAlloc(FColorMapSpec.ColorMapLength*2);
              Stream.Read(Buffer^,FColorMapSpec.ColorMapLength*2);
              for i:=0 to FColorMapSpec.ColorMapLength-1 do
                begin
                Color16:=Ord(Buffer[(i*2)+0])+Ord(Buffer[(i*2)+1])*256;
                FColorMap[i].Blue:=Color16to24[Color16 and 31];
                FColorMap[i].Green:=Color16to24[(Color16 and 992) shr 5];
                FColorMap[i].Red:=Color16to24[(Color16 and 31744) shr 10];
                FColorMap[i].Alpha:=0;
                end;
              end;
          16: begin
              Buffer:=AnsiStrAlloc(FColorMapSpec.ColorMapLength*2);
              Stream.Read(Buffer^,FColorMapSpec.ColorMapLength*2);
              for i:=0 to FColorMapSpec.ColorMapLength-1 do
                begin
                Color16:=Ord(Buffer[(i*2)+0])+Ord(Buffer[(i*2)+1])*256;
                FColorMap[i].Blue:=Color16to24[Color16 and 31];
                FColorMap[i].Green:=Color16to24[(Color16 and 992) shr 5];
                FColorMap[i].Red:=Color16to24[(Color16 and 31744) shr 10];
                FColorMap[i].Alpha:=0;
                end;
              end;
          24: begin
              Buffer:=AnsiStrAlloc(FColorMapSpec.ColorMapLength*3);
              Stream.Read(Buffer^,FColorMapSpec.ColorMapLength*3);
              for i:=0 to FColorMapSpec.ColorMapLength-1 do
                begin
                FColorMap[i].Blue:=Ord(Buffer[(i*3)+0]);
                FColorMap[i].Green:=Ord(Buffer[(i*3)+1]);
                FColorMap[i].Red:=Ord(Buffer[(i*3)+2]);
                FColorMap[i].Alpha:=0;
                end;
              end;
          32: begin
              Buffer:=AnsiStrAlloc(FColorMapSpec.ColorMapLength*4);
              Stream.Read(Buffer^,FColorMapSpec.ColorMapLength*4);
              for i:=0 to FColorMapSpec.ColorMapLength-1 do
                begin
                FColorMap[i].Blue:=Ord(Buffer[(i*4)+0]);
                FColorMap[i].Green:=Ord(Buffer[(i*4)+1]);
                FColorMap[i].Red:=Ord(Buffer[(i*4)+2]);
                FColorMap[i].Alpha:=Ord(Buffer[(i*4)+3]);
                end;
              end;
          end;
        System.AnsiStrings.StrDispose(Buffer);
        end;
      FBitmap.PixelFormat:=pf32bit;
      FBitmap.Width:=FImageSpec.Width;
      FBitmap.Height:=FImageSpec.Height;
      FAlphaChannel.PixelFormat:=pf32bit;
      FAlphaChannel.Width:=FImageSpec.Width;
      FAlphaChannel.Height:=FImageSpec.Height;
      LineSize:=FBitmap.Width*(FImageSpec.PixelDepth div 8);
      Buffer:=AnsiStrAlloc(LineSize);
      case FImageType of
        NO_IMAGEDATA_INCLUDED:
          begin
          FTargaType:=ttNoImageData;
          end;
        COLORMAPPED_IMAGE:
          begin
          FTargaType:=ttColorMapedImage;
          case FImageSpec.PixelDepth of
            8: begin
               FColorDepth:=cd8bit;
               FIncludeAlphaChannel:=False;
               for i:=0 to FImageSpec.Height-1 do
                 begin
                 if not FImageSpec.ImageDescriptor.Top and not FImageSpec.ImageDescriptor.Left then
                   LineBuffer:=FBitmap.ScanLine[FImageSpec.Height-(i+1)]
                 else
                   LineBuffer:=FBitmap.ScanLine[i];
                 Stream.Read(Buffer^,LineSize);
                 for j:=0 to FImageSpec.Width-1 do
                   begin
                   LineBuffer[(j*4)]:=FColorMap[Ord(Buffer[j])].Blue;
                   LineBuffer[(j*4)+1]:=FColorMap[Ord(Buffer[j])].Green;
                   LineBuffer[(j*4)+2]:=FColorMap[Ord(Buffer[j])].Red;
                   end;
                 end;
               end;
            16: begin
                end;
            24: begin
                end;
            32: begin
                end;
            end;
          end;
        TRUECOLOR_IMAGE:
          begin
          FTargaType:=ttTrueColorImage;
          case FImageSpec.PixelDepth of
            16: begin
                FColorDepth:=cd16bit;
                FIncludeAlphaChannel:=False;
                for i:=0 to FImageSpec.Height-1 do
                  begin
                  if not FImageSpec.ImageDescriptor.Top and not FImageSpec.ImageDescriptor.Left then
                    LineBuffer:=FBitmap.ScanLine[FImageSpec.Height-(i+1)]
                  else
                    LineBuffer:=FBitmap.ScanLine[i];
                  Stream.Read(Buffer^,LineSize);
                  for j:=0 to FImageSpec.Width-1 do
                    begin
                    tmp16:=Ord(Buffer[j*2])+Ord(Buffer[j*2+1])*256;
                    LineBuffer[(j*4)]:=Color16to24[(tmp16 and 31)];
                    LineBuffer[(j*4)+1]:=Color16to24[((tmp16 and 992) shr 5)];
                    LineBuffer[(j*4)+2]:=Color16to24[((tmp16 and 31744) shr 10)];
                    end;
                  end;
                end;
            24: begin
                FColorDepth:=cd24bit;
                FIncludeAlphaChannel:=False;
                for i:=0 to FImageSpec.Height-1 do
                  begin
                  if not FImageSpec.ImageDescriptor.Top and not FImageSpec.ImageDescriptor.Left then
                    LineBuffer:=FBitmap.ScanLine[FImageSpec.Height-(i+1)]
                  else
                    LineBuffer:=FBitmap.ScanLine[i];
                  Stream.Read(Buffer^,LineSize);
                  for j:=0 to FImageSpec.Width-1 do
                    begin
                    LineBuffer[(j*4)]:=Ord(Buffer[j*3]);
                    LineBuffer[(j*4)+1]:=Ord(Buffer[j*3+1]);
                    LineBuffer[(j*4)+2]:=Ord(Buffer[j*3+2]);
                    end;
                  end;
                end;
            32: begin
                FColorDepth:=cd32bit;
                FIncludeAlphaChannel:=True;
                for i:=0 to FImageSpec.Height-1 do
                  begin
                  if not FImageSpec.ImageDescriptor.Top and not FImageSpec.ImageDescriptor.Left then
                    begin
                    LineBuffer:=FBitmap.ScanLine[FImageSpec.Height-(i+1)];
                    AlphaBuffer:=FAlphaChannel.ScanLine[FImageSpec.Height-(i+1)];
                    end
                  else
                    begin
                    LineBuffer:=FBitmap.ScanLine[i];
                    AlphaBuffer:=FAlphaChannel.ScanLine[i];
                    end;
                  Stream.Read(Buffer^,LineSize);
                  for j:=0 to FImageSpec.Width-1 do
                    begin
                    LineBuffer[(j*4)]:=Ord(Buffer[j*4]);
                    LineBuffer[(j*4)+1]:=Ord(Buffer[j*4+1]);
                    LineBuffer[(j*4)+2]:=Ord(Buffer[j*4+2]);
                    AlphaBuffer[(j*4)]:=Ord(Buffer[j*4+3]);
                    AlphaBuffer[(j*4)+1]:=Ord(Buffer[j*4+3]);
                    AlphaBuffer[(j*4)+2]:=Ord(Buffer[j*4+3]);
                    end;
                  end;
                end;
            end;
          end;
        BLACKANDWHITE_IMAGE: GetBAWImageType(False);
        RLE_COLORMAPPED_IMAGE:
          begin
          FTargaType:=ttRLEColorMapedImage;
          case FImageSpec.PixelDepth of
            8: begin
               FColorDepth:=cd8bit;
               FIncludeAlphaChannel:=False;
               RLEBuffer:=AnsiStrAlloc(LineSize*2);
               for i:=0 to FImageSpec.Height-1 do
                 begin
                 if not FImageSpec.ImageDescriptor.Top and not FImageSpec.ImageDescriptor.Left then
                   LineBuffer:=FBitmap.ScanLine[FImageSpec.Height-(i+1)]
                 else
                   LineBuffer:=FBitmap.ScanLine[i];
                 ReadLength:=Stream.Read(RLEBuffer^,LineSize*2);
                 Stream.Position:=Stream.Position-ReadLength+RLEDecompress(FImageSpec.Width,RLEBuffer, Buffer);
                 for j:=0 to FImageSpec.Width-1 do
                   begin
                   LineBuffer[(j*4)]:=FColorMap[Ord(Buffer[j])].Blue;
                   LineBuffer[(j*4)+1]:=FColorMap[Ord(Buffer[j])].Green;
                   LineBuffer[(j*4)+2]:=FColorMap[Ord(Buffer[j])].Red;
                   end;
                 end;
               end;
            16: begin
                end;
            24: begin
                end;
            32: begin
                end;
            end;
          end;
        RLE_TRUECOLOR_IMAGE:
          begin
          FTargaType:=ttRLETrueColorImage;
          case FImageSpec.PixelDepth of
            16: begin
                FColorDepth:=cd16bit;
                FIncludeAlphaChannel:=False;
                RLEBuffer:=AnsiStrAlloc(LineSize*2);
                for i:=0 to FImageSpec.Height-1 do
                  begin
                  if not FImageSpec.ImageDescriptor.Top and not FImageSpec.ImageDescriptor.Left then
                    LineBuffer:=FBitmap.ScanLine[FImageSpec.Height-(i+1)]
                  else
                    LineBuffer:=FBitmap.ScanLine[i];
                  ReadLength:=Stream.Read(RLEBuffer^,LineSize*2);
                  Stream.Position:=Stream.Position-ReadLength+RLEDecompress(FImageSpec.Width*2,RLEBuffer, Buffer);
                  for j:=0 to FImageSpec.Width-1 do
                    begin
                    tmp16:=Ord(Buffer[j*2])+Ord(Buffer[j*2+1])*256;
                    LineBuffer[(j*4)]:=Color16to24[(tmp16 and 31)];
                    LineBuffer[(j*4)+1]:=Color16to24[((tmp16 and 992) shr 5)];
                    LineBuffer[(j*4)+2]:=Color16to24[((tmp16 and 31744) shr 10)];
                    end;
                  end;
                System.AnsiStrings.StrDispose(RLEBuffer);
                end;
            24: begin
                FColorDepth:=cd24bit;
                FIncludeAlphaChannel:=False;
                RLEBuffer:=AnsiStrAlloc(LineSize*2);
                for i:=0 to FImageSpec.Height-1 do
                  begin
                  if not FImageSpec.ImageDescriptor.Top and not FImageSpec.ImageDescriptor.Left then
                    LineBuffer:=FBitmap.ScanLine[FImageSpec.Height-(i+1)]
                  else
                    LineBuffer:=FBitmap.ScanLine[i];
                  ReadLength:=Stream.Read(RLEBuffer^,LineSize*2);
                  Stream.Position:=Stream.Position-ReadLength+RLEDecompress(FImageSpec.Width*3,RLEBuffer, Buffer);
                  for j:=0 to FImageSpec.Width-1 do
                    begin
                    LineBuffer[(j*4)]:=Ord(Buffer[j*3]);
                    LineBuffer[(j*4)+1]:=Ord(Buffer[j*3+1]);
                    LineBuffer[(j*4)+2]:=Ord(Buffer[j*3+2]);
                    end;
                  end;
                System.AnsiStrings.StrDispose(RLEBuffer);
                end;
            32: begin
                FColorDepth:=cd32bit;
                FIncludeAlphaChannel:=True;
                RLEBuffer:=AnsiStrAlloc(LineSize*2);
                for i:=0 to FImageSpec.Height-1 do
                  begin
                  if not FImageSpec.ImageDescriptor.Top and not FImageSpec.ImageDescriptor.Left then
                    begin
                    LineBuffer:=FBitmap.ScanLine[FImageSpec.Height-(i+1)];
                    AlphaBuffer:=FAlphaChannel.ScanLine[FImageSpec.Height-(i+1)];
                    end
                  else
                    begin
                    LineBuffer:=FBitmap.ScanLine[i];
                    AlphaBuffer:=FAlphaChannel.ScanLine[i];
                    end;
                  ReadLength:=Stream.Read(RLEBuffer^,LineSize*2);
                  Stream.Position:=Stream.Position-ReadLength+RLEDecompress(FImageSpec.Width*4,RLEBuffer, Buffer);
                  for j:=0 to FImageSpec.Width-1 do
                    begin
                    LineBuffer[(j*4)]:=Ord(Buffer[j*4]);
                    LineBuffer[(j*4)+1]:=Ord(Buffer[j*4+1]);
                    LineBuffer[(j*4)+2]:=Ord(Buffer[j*4+2]);
                    AlphaBuffer[(j*4)]:=Ord(Buffer[j*4+3]);
                    AlphaBuffer[(j*4)+1]:=Ord(Buffer[j*4+3]);
                    AlphaBuffer[(j*4)+2]:=Ord(Buffer[j*4+3]);
                    end;
                  end;
                System.AnsiStrings.StrDispose(RLEBuffer);
                end;
            end;
          end;
        RLE_BLACKANDWHITE_IMAGE: GetBAWImageType(True);
        end;
      System.AnsiStrings.StrDispose(Buffer);
      if Assigned(FOnChange) then FOnChange(self);
    end;
    
    procedure TTarga.LoadFromClipboardFormat(Format: Word; Data: THandle; Palette: HPALETTE);
    var tmpStream: TMemoryStream;
        tmpLen: Cardinal;
        i: Integer;
        Buffer, NewBuffer: PChar;
    begin
      if (Format <> CF_TARGA) or (Data = 0) then Exit;
      Buffer:=PChar(Data);
      tmpStream:=TMemoryStream.Create;
      tmpLen:=Ord(Buffer[0])+Ord(Buffer[1])*256+Ord(Buffer[2])*65536+Ord(Buffer[3])*16777216;
      NewBuffer:=StrAlloc(tmpLen);
      for i:=4 to tmpLen+3 do NewBuffer[i-4]:=Buffer[i];
      tmpStream.Write(NewBuffer^,tmpLen+4);
      StrDispose(NewBuffer);
      tmpStream.Position:=0;
      LoadFromStream(tmpStream);
      tmpStream.Free;
    end;
    
    procedure TTarga.LoadFromClipboard(LoadType: TTargaClipboardType);
    var tmpData, tmpPalette: Thandle;
    begin
      case LoadType of
        ctTarga: begin
                 tmpData:=ClipBoard.GetAsHandle(CF_TARGA);
                 if tmpData=0 then Exit;
                 tmpPalette:=0;
                 LoadFromClipboardFormat(CF_TARGA, tmpData, tmpPalette);
                 end;
        ctBitmap: begin
                  tmpData:=ClipBoard.GetAsHandle(CF_BITMAP);
                  if tmpData=0 then Exit;
                  tmpPalette:=0;
                  FBitmap.LoadFromClipboardFormat(CF_BITMAP, tmpData, tmpPalette);
                  end;
        ctAlphaChannel: begin
                        tmpData:=ClipBoard.GetAsHandle(CF_BITMAP);
                        if tmpData=0 then Exit;
                        tmpPalette:=0;
                        FAlphaChannel.LoadFromClipboardFormat(CF_BITMAP, tmpData, tmpPalette);
                        end;
        end;
      if Assigned(FOnChange) then FOnChange(self);
    end;
    
    procedure TTarga.SaveToStream(Stream: TStream);
    type
      TRGBCount = record
        RGBA: TRGBA;
        Count: Integer;
        end;
    
    var Buffer: PAnsiChar;
        RLEBuffer: PAnsiChar;
        i, j: Integer;
        Color16: Word;
        LineSize, RLELineSize: Integer;
        LineBuffer, AlphaBuffer: PByteArray;
        tmpPosition: Integer;
        BytePerPixel: Byte;
    
    begin
      case FTargaType of
        ttRLETrueColorImage:
          begin
          Buffer:=AnsiStrAlloc(18);
          Buffer[0]:=Chr(0);
          Buffer[1]:=Chr(0);
          Buffer[2]:=Chr(RLE_TRUECOLOR_IMAGE);
          Buffer[3]:=Chr(0);
          Buffer[4]:=Chr(0);
          Buffer[5]:=Chr(0);
          Buffer[6]:=Chr(0);
          Buffer[7]:=Chr(0);
          Buffer[8]:=Chr(0);
          Buffer[9]:=Chr(0);
          Buffer[10]:=Chr(0);
          Buffer[11]:=Chr(0);
          Buffer[12]:=AnsiChar(Chr(FBitmap.Width mod 256));
          Buffer[13]:=AnsiChar(Chr(FBitmap.Width div 256));
          Buffer[14]:=AnsiChar(Chr(FBitmap.Height mod 256));
          Buffer[15]:=AnsiChar(Chr(FBitmap.Height div 256));
          Buffer[16]:=Chr(24);
          Buffer[17]:=Chr(0);
          Stream.Write(Buffer^,18);
    
          System.AnsiStrings.StrDispose(Buffer);
          LineSize:=FBitmap.Width*3;
          Buffer:=AnsiStrAlloc(LineSize);
          RLEBuffer:=AnsiStrAlloc(LineSize*2);
          for i:=0 to FBitmap.Height-1 do
            begin
            LineBuffer:=FBitmap.ScanLine[FBitmap.Height-(i+1)];
            for j:=0 to FBitmap.Width-1 do
              begin
              Buffer[j*3]:=AnsiChar(Chr(LineBuffer[j*4]));
              Buffer[j*3+1]:=AnsiChar(Chr(LineBuffer[j*4+1]));
              Buffer[j*3+2]:=AnsiChar(Chr(LineBuffer[j*4+2]));
              end;
            RLELineSize:=RLECompress(LineSize,RLEBuffer,Buffer);
            tmpPosition:=Stream.Position;
            Stream.Size:=Stream.Size+RLELineSize;
            Stream.Position:=tmpPosition;
            Stream.Write(RLEBuffer^,RLELineSize);
            end;
          System.AnsiStrings.StrDispose(Buffer);
          System.AnsiStrings.StrDispose(RLEBuffer);
          end;
        else
          begin
          if (FBitmap.Width<>FAlphaChannel.Width) or (FBitmap.Height<>FAlphaChannel.Height) then
            begin
            FAlphaChannel.Width:=FBitmap.Width;
            FAlphaChannel.Height:=FBitmap.Height;
            end;
          case FColorDepth of
            cd16bit: BytePerPixel:=2;
            cd24bit: BytePerPixel:=3;
            cd32bit: BytePerPixel:=4;
            else BytePerPixel:=3;
            end;
          Buffer:=AnsiStrAlloc(18);
          Buffer[0]:=Chr(0);
          Buffer[1]:=Chr(0);
          Buffer[2]:=Chr(TRUECOLOR_IMAGE);
          Buffer[3]:=Chr(0);
          Buffer[4]:=Chr(0);
          Buffer[5]:=Chr(0);
          Buffer[6]:=Chr(0);
          Buffer[7]:=Chr(0);
          Buffer[8]:=Chr(0);
          Buffer[9]:=Chr(0);
          Buffer[10]:=Chr(0);
          Buffer[11]:=Chr(0);
          Buffer[12]:=AnsiChar(Chr(FBitmap.Width mod 256));
          Buffer[13]:=AnsiChar(Chr(FBitmap.Width div 256));
          Buffer[14]:=AnsiChar(Chr(FBitmap.Height mod 256));
          Buffer[15]:=AnsiChar(Chr(FBitmap.Height div 256));
          Buffer[16]:=AnsiChar(Chr(8*BytePerPixel));
          Buffer[17]:=Chr(0);
          Stream.Write(Buffer^,18);
          System.AnsiStrings.StrDispose(Buffer);
          LineSize:=FBitmap.Width*BytePerPixel;
          Buffer:=AnsiStrAlloc(LineSize);
          for i:=0 to FBitmap.Height-1 do
            begin
            LineBuffer:=FBitmap.ScanLine[FBitmap.Height-(i+1)];
            AlphaBuffer:=FAlphaChannel.ScanLine[FBitmap.Height-(i+1)];
            for j:=0 to FBitmap.Width-1 do
              begin
              case FColorDepth of
                cd16bit: begin
                         Color16:=(Word(LineBuffer[j*4]) div 8) or ((Word(LineBuffer[(j*4)+1]) div 8) shl 5) or ((Word(LineBuffer[(j*4)+2]) div 8) shl 10);
                         Buffer[(j*2)]:=AnsiChar(Chr(Lo(Color16)));
                         Buffer[(j*2)+1]:=AnsiChar(Chr(Hi(Color16)));
                         end;
                cd24bit: begin
                         Buffer[j*3]:=AnsiChar(Chr(LineBuffer[j*4]));
                         Buffer[j*3+1]:=AnsiChar(Chr(LineBuffer[j*4+1]));
                         Buffer[j*3+2]:=AnsiChar(Chr(LineBuffer[j*4+2]));
                         end;
                cd32bit: begin
                         Buffer[j*4]:=AnsiChar(Chr(LineBuffer[j*4]));
                         Buffer[j*4+1]:=AnsiChar(Chr(LineBuffer[j*4+1]));
                         Buffer[j*4+2]:=AnsiChar(Chr(LineBuffer[j*4+2]));
                         Buffer[j*4+3]:=AnsiChar(Chr(AlphaBuffer[j*4]));
                         end;
                end;
              end;
            Stream.Write(Buffer^,LineSize);
            end;
          System.AnsiStrings.StrDispose(Buffer);
          end;
      end;
    end;
    
    procedure TTarga.SaveToClipboardFormat(var Format: Word; var Data: THandle; var Palette: HPALETTE);
    var tmpStream: TMemoryStream;
        Buffer: PChar;
    begin
      Format:=CF_TARGA;
      tmpStream:=TMemoryStream.Create;
      SaveToStream(tmpStream);
      Buffer:=StrAlloc(tmpStream.Size+4);
      tmpStream.Position:=0;
      Buffer[3]:=Char(tmpStream.Size div 16777216);
      Buffer[2]:=Char((tmpStream.Size mod 16777216) div 65536);
      Buffer[1]:=Char(((tmpStream.Size mod 16777216) mod 65536) div 256);
      Buffer[0]:=Char(((tmpStream.Size mod 16777216) mod 65536) mod 256);
      Inc(Buffer,4);
      tmpStream.Read(Buffer^,tmpStream.Size);
      Dec(Buffer,4);
      Data:=Integer(Buffer);
      Palette:=0;
      tmpStream.Free;
    end;
    
    procedure TTarga.SaveToClipboard(SaveType: TTargaClipboardType);
    var  tmpFormat : Word;
         tmpData : Thandle;
         tmpPalette: HPALETTE;
    begin
      case SaveType of
        ctTarga: begin
                 SaveToClipboardFormat(tmpFormat, tmpData, tmpPalette);
                 ClipBoard.SetAsHandle(tmpFormat,tmpData);
                 end;
        ctBitmap: begin
                  FBitmap.SaveToClipboardFormat(tmpFormat, tmpData, tmpPalette);
                  ClipBoard.SetAsHandle(tmpFormat,tmpData);
                  end;
        ctAlphaChannel: begin
                        FAlphaChannel.SaveToClipboardFormat(tmpFormat, tmpData, tmpPalette);
                        ClipBoard.SetAsHandle(tmpFormat,tmpData);
                        end;
        end;
    end;
    
    function TTarga.RLEDecompress(DataLength: Integer; var RLEBuffer: PAnsiChar; var Buffer: PAnsiChar): Integer;
    var RLEPacketType: Boolean;
        RLEPacketLength: Integer;
        RAWDataPosition: Integer;
        RLEPacketPosition: Integer;
        j: Integer;
    begin
      RLEPacketPosition:=0;
      RAWDataPosition:=0;
      case FImageSpec.PixelDepth of
        8: begin
           while True do
             begin
             RLEPacketType:=Ord(RLEBuffer[RLEPacketPosition])>127;
             RLEPacketLength:=1+Ord(RLEBuffer[RLEPacketPosition]) and 127;
             if RLEPacketType then
               begin
               for j:=0 to RLEPacketLength-1 do
                 begin
                 Buffer[RAWDataPosition]:=RLEBuffer[RLEPacketPosition+1];
                 Inc(RAWDataPosition);
                 end;
               Inc(RLEPacketPosition,2)
               end
             else
               begin
               for j:=0 to RLEPacketLength-1 do
                 begin
                 Buffer[RAWDataPosition]:=RLEBuffer[RLEPacketPosition+j+1];
                 Inc(RAWDataPosition);
                 end;
               Inc(RLEPacketPosition,RLEPacketLength+1)
               end;
             if RAWDataPosition>=DataLength then Break;
             end;
           end;
        16: begin
            while True do
              begin
              RLEPacketType:=Ord(RLEBuffer[RLEPacketPosition])>127;
              RLEPacketLength:=1+Ord(RLEBuffer[RLEPacketPosition]) and 127;
              if RLEPacketType then
                begin
                for j:=0 to RLEPacketLength-1 do
                  begin
                  Buffer[RAWDataPosition]:=RLEBuffer[RLEPacketPosition+1];
                  Buffer[RAWDataPosition+1]:=RLEBuffer[RLEPacketPosition+2];
                  Inc(RAWDataPosition,2);
                  end;
                Inc(RLEPacketPosition,3)
                end
              else
                begin
                for j:=0 to RLEPacketLength-1 do
                  begin
                  Buffer[RAWDataPosition]:=RLEBuffer[RLEPacketPosition+j*2+1];
                  Buffer[RAWDataPosition+1]:=RLEBuffer[RLEPacketPosition+j*2+2];
                  Inc(RAWDataPosition,2);
                  end;
                Inc(RLEPacketPosition,RLEPacketLength*2+1)
                end;
              if RAWDataPosition>=DataLength then Break;
              end;
            end;
        24: begin
            while True do
              begin
              RLEPacketType:=Ord(RLEBuffer[RLEPacketPosition])>127;
              RLEPacketLength:=(Ord(RLEBuffer[RLEPacketPosition]) and 127)+1;
              if RLEPacketType then
                begin
                for j:=0 to RLEPacketLength-1 do
                  begin
                  Buffer[RAWDataPosition]:=RLEBuffer[RLEPacketPosition+1];
                  Buffer[RAWDataPosition+1]:=RLEBuffer[RLEPacketPosition+2];
                  Buffer[RAWDataPosition+2]:=RLEBuffer[RLEPacketPosition+3];
                  Inc(RAWDataPosition,3);
                  end;
                Inc(RLEPacketPosition,4)
                end
              else
                begin
                for j:=0 to RLEPacketLength-1 do
                  begin
                  Buffer[RAWDataPosition]:=RLEBuffer[RLEPacketPosition+j*3+1];
                  Buffer[RAWDataPosition+1]:=RLEBuffer[RLEPacketPosition+j*3+2];
                  Buffer[RAWDataPosition+2]:=RLEBuffer[RLEPacketPosition+j*3+3];
                  Inc(RAWDataPosition,3);
                  end;
                Inc(RLEPacketPosition,RLEPacketLength*3+1)
                end;
              if RAWDataPosition>=DataLength then Break;
              end;
            end;
        32: begin
            while True do
              begin
              RLEPacketType:=Ord(RLEBuffer[RLEPacketPosition])>127;
              RLEPacketLength:=1+Ord(RLEBuffer[RLEPacketPosition]) and 127;
              if RLEPacketType then
                begin
                for j:=0 to RLEPacketLength-1 do
                  begin
                  Buffer[RAWDataPosition]:=RLEBuffer[RLEPacketPosition+1];
                  Buffer[RAWDataPosition+1]:=RLEBuffer[RLEPacketPosition+2];
                  Buffer[RAWDataPosition+2]:=RLEBuffer[RLEPacketPosition+3];
                  Buffer[RAWDataPosition+3]:=RLEBuffer[RLEPacketPosition+4];
                  Inc(RAWDataPosition,4);
                  end;
                Inc(RLEPacketPosition,5)
                end
              else
                begin
                for j:=0 to RLEPacketLength-1 do
                  begin
                  Buffer[RAWDataPosition]:=RLEBuffer[RLEPacketPosition+j*4+1];
                  Buffer[RAWDataPosition+1]:=RLEBuffer[RLEPacketPosition+j*4+2];
                  Buffer[RAWDataPosition+2]:=RLEBuffer[RLEPacketPosition+j*4+3];
                  Buffer[RAWDataPosition+3]:=RLEBuffer[RLEPacketPosition+j*4+4];
                  Inc(RAWDataPosition,4);
                  end;
                Inc(RLEPacketPosition,RLEPacketLength*4+1)
                end;
              if RAWDataPosition>=DataLength then Break;
              end;
            end;
        end;
      Result:=RLEPacketPosition;
    end;
    
    function TTarga.RLECompress(DataLength: Integer; var RLEBuffer: PAnsiChar; var Buffer: PAnsiChar): Integer;
    var ByteR, ByteG, ByteB, ByteA: Byte;
        ByteCount: Integer;
        RAWDataPosition: Integer;
        IsRLEPacket: Boolean;
        RLEDataPosition: Integer;
        RAWPacketHeaderPos: Integer;
    begin
      IsRLEPacket:=False;
      RAWDataPosition:=0;
      RLEDataPosition:=0;
      RAWPacketHeaderPos:=0;
      ByteCount:=0;
      ByteR:=Ord(Buffer[RAWDataPosition]);
      ByteG:=Ord(Buffer[RAWDataPosition+1]);
      ByteB:=Ord(Buffer[RAWDataPosition+2]);
      Inc(RAWDataPosition,3);
      while True do
        begin
        if (RAWDataPosition>=DataLength) or (ByteCount=127) then
          begin
          if IsRLEPacket then
            begin
            RLEBuffer[RLEDataPosition]:=AnsiChar(Chr(128+ByteCount));
            RLEBuffer[RLEDataPosition+1]:=AnsiChar(Chr(ByteR));
            RLEBuffer[RLEDataPosition+2]:=AnsiChar(Chr(ByteG));
            RLEBuffer[RLEDataPosition+3]:=AnsiChar(Chr(ByteB));
            Inc(RLEDataPosition,4);
            Inc(RAWDataPosition,3);
            ByteCount:=0;
            RAWPacketHeaderPos:=RLEDataPosition;
            IsRLEPacket:=False;
            end
          else
            begin
            RLEBuffer[RAWPacketHeaderPos]:=AnsiChar(Chr(ByteCount));
            if ByteCount>0 then
              begin
              RLEBuffer[RLEDataPosition]:=AnsiChar(Chr(ByteR));
              RLEBuffer[RLEDataPosition+1]:=AnsiChar(Chr(ByteG));
              RLEBuffer[RLEDataPosition+2]:=AnsiChar(Chr(ByteB));
              Inc(RLEDataPosition,3)
              end
            else
              begin
              RLEBuffer[RLEDataPosition+1]:=AnsiChar(Chr(ByteR));
              RLEBuffer[RLEDataPosition+2]:=AnsiChar(Chr(ByteG));
              RLEBuffer[RLEDataPosition+3]:=AnsiChar(Chr(ByteB));
              Inc(RLEDataPosition,4);
              end;
            Inc(RAWDataPosition,3);
            ByteR:=Ord(Buffer[RAWDataPosition]);
            ByteG:=Ord(Buffer[RAWDataPosition+1]);
            ByteB:=Ord(Buffer[RAWDataPosition+2]);
            ByteCount:=0;
            RAWPacketHeaderPos:=RLEDataPosition;
            end;
          if (RAWDataPosition>=DataLength) then Break;
          end;
        if (ByteR=Ord(Buffer[RAWDataPosition])) and (ByteG=Ord(Buffer[RAWDataPosition+1])) and (ByteB=Ord(Buffer[RAWDataPosition+2])) then
          begin
          if not IsRLEPacket then ByteCount:=0;
          Inc(ByteCount);
          Inc(RAWDataPosition,3);
          IsRLEPacket:=True;
          end
        else
          begin
          if IsRLEPacket then
            begin
            RLEBuffer[RLEDataPosition]:=AnsiChar(Chr(128+ByteCount));
            RLEBuffer[RLEDataPosition+1]:=AnsiChar(Chr(ByteR));
            RLEBuffer[RLEDataPosition+2]:=AnsiChar(Chr(ByteG));
            RLEBuffer[RLEDataPosition+3]:=AnsiChar(Chr(ByteB));
            Inc(RLEDataPosition,4);
            ByteR:=Ord(Buffer[RAWDataPosition]);
            ByteG:=Ord(Buffer[RAWDataPosition+1]);
            ByteB:=Ord(Buffer[RAWDataPosition+2]);
            Inc(RAWDataPosition,3);
            ByteCount:=0;
            RAWPacketHeaderPos:=RLEDataPosition;
            IsRLEPacket:=False;
            end
          else
            begin
            RLEBuffer[RAWPacketHeaderPos]:=AnsiChar(Chr(ByteCount));
            if ByteCount>0 then
              begin
              RLEBuffer[RLEDataPosition]:=AnsiChar(Chr(ByteR));
              RLEBuffer[RLEDataPosition+1]:=AnsiChar(Chr(ByteG));
              RLEBuffer[RLEDataPosition+2]:=AnsiChar(Chr(ByteB));
              Inc(RLEDataPosition,3)
              end
            else
              begin
              RLEBuffer[RLEDataPosition+1]:=AnsiChar(Chr(ByteR));
              RLEBuffer[RLEDataPosition+2]:=AnsiChar(Chr(ByteG));
              RLEBuffer[RLEDataPosition+3]:=AnsiChar(Chr(ByteB));
              Inc(RLEDataPosition,4);
              end;
            ByteR:=Ord(Buffer[RAWDataPosition]);
            ByteG:=Ord(Buffer[RAWDataPosition+1]);
            ByteB:=Ord(Buffer[RAWDataPosition+2]);
            Inc(RAWDataPosition,3);
            Inc(ByteCount);
            end;
          end;
        end;
      Result:=RLEDataPosition;
    end;
    
    
    end.
    
    
    • Public Snippets
    • Channels Snippets