home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 November / DPPCPRO1199.ISO / RWC / VisProg.exe / UStreamDemo.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-07-24  |  2.7 KB  |  103 lines
  1. unit UStreamDemo;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ListBox1: TListBox;
  12.     Image1: TImage;
  13.     Label1: TLabel;
  14.     procedure FormCreate(Sender: TObject);
  15.     procedure ListBox1Click(Sender: TObject);
  16.   private
  17.     { Private declarations }
  18.   public
  19.     { Public declarations }
  20.     procedure ReadTemplate (Stream: TFileStream);
  21.     function ReadBitmap (Stream: TFileStream): TBitmap;
  22.   end;
  23.  
  24. var
  25.   Form1: TForm1;
  26.  
  27. implementation
  28.  
  29. {$R *.DFM}
  30.  
  31. function TForm1.ReadBitmap (Stream: TFileStream): TBitmap;
  32. var
  33.     BmpSize: Integer;
  34.     TempStream: TMemoryStream;
  35. begin
  36.     Result := TBitmap.Create;
  37.     Stream.Read (BmpSize, sizeof (BmpSize));
  38.     // If we've got a bitmap.......
  39.     if BmpSize > 0 then begin
  40.         TempStream := TMemoryStream.Create;
  41.         try
  42.             TempStream.CopyFrom (Stream, BmpSize);
  43.             TempStream.Position := 0;
  44.             Result.LoadFromStream (TempStream);
  45.         finally
  46.             TempStream.Free;
  47.         end;
  48.     end;
  49. end;
  50.  
  51. procedure TForm1.ReadTemplate (Stream: TFileStream);
  52. var
  53.     Len: Byte;
  54.     Name: String;                  // name of this entry
  55.     PageName: String;              // pagename of this entry
  56.     StartPos: Integer;             // position of this entry
  57.     TemplateSize: Integer;         // size of this entry
  58. begin
  59.     Stream.Read (TemplateSize, sizeof (TemplateSize));
  60.     StartPos := Stream.Position;
  61.  
  62.     // Read name of this entry
  63.     Stream.Read (Len, sizeof (Len));
  64.     SetLength (Name, Len);
  65.     if Len > 0 then Stream.Read (PChar (Name)^, Len);
  66.  
  67.     // Read component template page of this entry
  68.     Stream.Read (Len, sizeof (Len));
  69.     SetLength (PageName, Len);
  70.     if Len > 0 then Stream.Read (PChar (PageName)^, Len);
  71.     
  72.     ListBox1.Items.AddObject (Format ('%s (Page = %s)', [Name, PageName]), ReadBitmap (Stream));
  73.     Stream.Position := StartPos + TemplateSize;
  74. end;
  75.  
  76. procedure TForm1.FormCreate(Sender: TObject);
  77. var
  78.     Ch: Char;
  79.     FileStream: TFileStream;
  80. begin
  81.     // Open the component template library
  82.     FileStream := TFileStream.Create ('D:\Delphi3\BIN\DELPHI32.DCT', fmOpenRead);
  83.     try
  84.         // Skip the DCT header string
  85.         repeat
  86.             FileStream.Read (Ch, sizeof (Ch));
  87.         until Ch = #$1A;
  88.  
  89.         while FileStream.Position < FileStream.Size do ReadTemplate (FileStream);
  90.     finally
  91.         FileStream.Free;
  92.     end;
  93. end;
  94.  
  95. procedure TForm1.ListBox1Click(Sender: TObject);
  96. begin
  97.     with ListBox1 do if ItemIndex >= 0 then begin
  98.         Image1.Picture.Bitmap.Assign (TBitmap (Items.Objects [ItemIndex]));
  99.     end;
  100. end;
  101.  
  102. end.
  103.