units/jpegobj/jpegobj_demo/MainJpg.pas

   1 { KOL MCK } // Do not remove this line!
   2 {$DEFINE KOL_MCK}
   3 unit MainJpg;
   4
   5 interface
   6
   7 //{$DEFINE BMPONLY}
   8 //{$DEFINE TEST_JPGPROGRESS}
   9
  10 {$IFDEF KOL_MCK}
  11 uses Windows, Messages, ShellAPI, KOL {$IFNDEF KOL_MCK}, mirror, Classes,
  12   mckCtrls, Controls {$ENDIF} {$IFNDEF BMPONLY}, JpegObj {$ENDIF};
  13 {$ELSE}
  14 {$I uses.inc} mirror,
  15   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
  16 {$ENDIF}
  17
  18 type
  19   {$IFDEF KOL_MCK}
  20   {$I MCKfakeClasses.inc}
  21   PForm1 = ^TForm1;
  22   TForm1 = object(TObj)
  23     Form: PControl;
  24   {$ELSE not_KOL_MCK}
  25   TForm1 = class(TForm)
  26   {$ENDIF KOL_MCK}
  27     KOLProject1: TKOLProject;
  28     KOLForm1: TKOLForm;
  29     PaintBox1: TKOLPaintBox;
  30     ListBox1: TKOLListBox;
  31     Panel1: TKOLPanel;
  32     Label1: TKOLLabel;
  33     procedure KOLForm1FormCreate(Sender: PObj);
  34     procedure ListBox1SelChange(Sender: PObj);
  35     procedure KOLForm1Destroy(Sender: PObj);
  36     procedure PaintBox1Paint(Sender: PControl; DC: HDC);
  37   private
  38     { Private declarations }
  39   public
  40     { Public declarations }
  41     JPG: {$IFDEF BMPONLY} PBitmap; {$ELSE} PJpeg; {$ENDIF}
  42     {$IFNDEF BMPONLY}
  43     procedure JpegProgress( Sender: PJpeg; const R: TRect; var Stop: Boolean );
  44     {$ENDIF}
  45   end;
  46
  47 var
  48   Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;
  49
  50 {$IFDEF KOL_MCK}
  51 procedure NewForm1( var Result: PForm1; AParent: PControl );
  52 {$ENDIF}
  53
  54 implementation
  55
  56 {$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}
  57
  58 {$IFDEF KOL_MCK}
  59 {$I MainJpg_1.inc}
  60 {$ENDIF}
  61
  62 procedure TForm1.KOLForm1FormCreate(Sender: PObj);
  63 begin
  64   {$IFDEF BMPONLY}
  65   ListBox1.AddDirList( GetStartDir + '*.bmp', FILE_ATTRIBUTE_NORMAL );
  66   {$ELSE}
  67   ListBox1.AddDirList( GetStartDir + '*.jp*', FILE_ATTRIBUTE_NORMAL );
  68   {$ENDIF}
  69 end;
  70
  71 procedure TForm1.ListBox1SelChange(Sender: PObj);
  72 var S: String;
  73 begin
  74   S := ListBox1.Items[ ListBox1.CurIndex ];
  75   if FileExists( S ) then
  76   begin
  77     JPG.Free;
  78     {$IFDEF BMPONLY}
  79     JPG := NewBitmap(0,0);
  80     JPG.LoadFromFile( S );
  81     //JPG.PixelFormat := pf16bit;
  82     {$ELSE}
  83     JPG := NewJpeg;
  84       {$IFDEF TEST_JPGPROGRESS}
  85       JPG.OnProgress := JpegProgress;
  86       PaintBox1.Canvas.FillRect( PaintBox1.ClientRect );
  87       {$ENDIF}
  88     JPG.LoadFromFile( S );
  89     Label1.Caption := '';
  90     {$ENDIF}
  91     //if not JPG.Empty then
  92       PaintBox1.Invalidate;
  93   end;
  94 end;
  95
  96 procedure TForm1.KOLForm1Destroy(Sender: PObj);
  97 begin
  98   JPG.Free;
  99 end;
 100
 101 procedure TForm1.PaintBox1Paint(Sender: PControl; DC: HDC);
 102 begin
 103   if (JPG <> nil) and not JPG.Empty then
 104   begin
 105     JPG.Draw( DC, 0, 0 );
 106     Sender.Canvas.FillRect( MakeRect( JPG.Width, 0, Sender.ClientWidth, Sender.ClientHeight ) );
 107     Sender.Canvas.FillRect( MakeRect( 0, JPG.Height, JPG.Width, Sender.ClientHeight ) );
 108     {$IFNDEF BMPONLY}
 109     if Label1.Caption = '' then
 110     if JPG.Corrupted then
 111       Label1.Caption := 'Corrupted';
 112     {$ENDIF}
 113   end
 114     else
 115     Sender.Canvas.FillRect( Sender.ClientRect );
 116 end;
 117
 118 {$IFNDEF BMPONLY}
 119 procedure TForm1.JpegProgress(Sender: PJpeg; const R: TRect;
 120   var Stop: Boolean);
 121 begin
 122   if not JPG.Bitmap.Empty then
 123     JPG.Bitmap.DIBDrawRect( PaintBox1.Canvas.Handle, R.Left, R.Top, R );
 124   if JPG.Corrupted then
 125   if Label1.Caption = '' then
 126     Label1.Caption := 'Corrupted';
 127   //Sleep( 40 );
 128 end;
 129 {$ENDIF}
 130
 131 end.
 132
 133