home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / comps / widgets / delphi10 / pcximage / pcximage.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-18  |  2.4 KB  |  111 lines
  1. unit Pcximage;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, DelphPCX;
  8.  
  9. type
  10.   TPCXImage = class(TImage)
  11.   private
  12.     { Private declarations }
  13.     FTheFileName : String;
  14.     ThePCXFO  : TPCXFileObject;
  15.   protected
  16.     { Protected declarations }
  17.     OldFileName : String;
  18.     TheBitmap : TBitmap;
  19.     valid_load : Boolean;
  20.   public
  21.     { Public declarations }
  22.     constructor Create( AOwner : TComponent ); override;
  23.     destructor Destroy; override;
  24.     procedure Paint; override;
  25.     procedure LoadPCXFile;
  26.   published
  27.     { Published declarations }
  28.     property TheFileName : String read FTheFileName write FTheFileName;
  29.   end;
  30.  
  31. procedure Register;
  32.  
  33. implementation
  34.  
  35. constructor TPCXImage.Create( AOwner : TComponent );
  36. begin
  37.   inherited Create( AOwner );
  38.   TheBitmap := TBitmap.Create;
  39.   ThePCXFO := TPCXFileObject.Create;
  40. end;
  41.  
  42. destructor TPCXImage.Destroy;
  43. begin
  44.   TheBitmap.Free;
  45.   ThePCXFO.Free;
  46.   inherited Destroy;
  47. end;
  48.  
  49. procedure TPCXImage.LoadPCXFile;
  50. var ThePChar : PChar;
  51.     TheBMP   : hBitmap;
  52.     ThePalette : hPalette;
  53. begin
  54.   Valid_Load := false;
  55.   if not FileExists( TheFileName ) then
  56.   begin
  57.     MessageDlg( TheFileName + ' cannot be found!',mterror,[mbOK],0);
  58.     exit;
  59.   end;
  60.   Screen.Cursor := crHourGlass;
  61.   GetMem( ThePChar , 256 );
  62.   StrPCopy( ThePChar , theFileName );
  63.   ThePCXFO.Init( ThePChar );
  64.   Freemem( ThePChar , 256 );
  65.   ThePCXFO.LoadPCXBitmap( TheBMP , ThePalette );
  66.   TheBitmap.Handle := TheBMP;
  67.   TheBitmap.Palette := ThePalette;
  68.   Screen.Cursor := crDefault;
  69.   oldFileName := TheFileName;
  70.   valid_load := true;
  71. end;
  72.  
  73. procedure TPCXImage.Paint;
  74. begin
  75.   if csDesigning in ComponentState then
  76.   begin
  77.     inherited Paint;
  78.     exit;
  79.   end;
  80.   if TheFileName = '' then
  81.   begin
  82.     inherited Paint;
  83.     exit;
  84.   end;
  85.   if oldfilename <> Thefilename then
  86.   begin
  87.     LoadPCXFile;
  88.     if not Valid_load then
  89.     begin
  90.       Picture.Bitmap.Height := 0;
  91.       Picture.Bitmap.Width := 0;
  92.       inherited Paint;
  93.       exit;
  94.     end;
  95.     Picture.Bitmap.Height := TheBitmap.Height;
  96.     Picture.Bitmap.Width := TheBitmap.Width;
  97.     Picture.Bitmap.Handle := TheBitmap.Handle;
  98.     inherited Paint;
  99.     exit;
  100.   end;
  101.   inherited Paint;
  102. end;
  103.  
  104.  
  105. procedure Register;
  106. begin
  107.   RegisterComponents('Widgets', [TPCXImage]);
  108. end;
  109.  
  110. end.
  111.