demos/menubitmaps/Unit1.pas

   1 { KOL MCK } // Do not remove this line!
   2 {$DEFINE KOL_MCK}
   3 unit Unit1;
   4
   5 interface
   6
   7 {$IFDEF KOL_MCK}
   8 uses Windows, Messages, ShellAPI, KOL {$IFNDEF KOL_MCK}, mirror, Classes,
   9   mckObjs, Controls, mckCtrls {$ENDIF};
  10 {$ELSE}
  11 {$I uses.inc}
  12   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  13   mirror;
  14 {$ENDIF}
  15
  16 type
  17   {$IFDEF KOL_MCK}
  18   {$I MCKfakeClasses.inc}
  19   PForm1 = ^TForm1;
  20   TForm1 = object(TObj)
  21     Form: PControl;
  22   {$ELSE not_KOL_MCK}
  23   TForm1 = class(TForm)
  24   {$ENDIF KOL_MCK}
  25     KOLProject1: TKOLProject;
  26     KOLForm1: TKOLForm;
  27     MainMenu1: TKOLMainMenu;
  28     Button1: TKOLButton;
  29     procedure Button1Click(Sender: PObj);
  30   private
  31     { Private declarations }
  32   public
  33     { Public declarations }
  34   end;
  35
  36 var
  37   Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;
  38
  39 {$IFDEF KOL_MCK}
  40 procedure NewForm1( var Result: PForm1; AParent: PControl );
  41 {$ENDIF}
  42
  43 implementation
  44
  45 {$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}
  46
  47 {$IFDEF KOL_MCK}
  48 {$I Unit1_1.inc}
  49 {$ENDIF}
  50
  51 var CurH: Integer = 29;
  52
  53 procedure TForm1.Button1Click(Sender: PObj);
  54 var Bmp: HBitmap;
  55     TmpBmp, OldBmp: PBitmap;
  56     H: Integer;
  57 begin
  58   Bmp := MainMenu1.ItemBitmap[ 1 ];
  59   if Bmp <> 0 then
  60   begin
  61     H := GetSystemMetrics( SM_CYMENUCHECK );
  62     if H = CurH then Exit;
  63     TmpBmp := NewDIBBitmap( H, H, pf24bit );
  64     OldBmp := NewBitmap( CurH, CurH );
  65     OldBmp.Handle := Bmp;
  66     SetStretchBltMode( TmpBmp.Canvas.Handle, HALFTONE );
  67     SetBrushOrgEx( TmpBmp.Canvas.Handle, 0, 0, nil );
  68     StretchBlt( TmpBmp.Canvas.Handle, 0, 0, H, H, OldBmp.Canvas.Handle, 0, 0,
  69                 CurH, CurH, SRCCOPY );
  70     //TmpBmp.SaveToFile( 'c:\test.bmp' );
  71     OldBmp.ReleaseHandle;
  72     Bmp := TmpBmp.Handle;
  73     TmpBmp.ReleaseHandle;
  74     OldBmp.Free;
  75     TmpBmp.Free;
  76     CurH := H;
  77     MainMenu1.ItemBitmap[ 1 ] := Bmp;
  78   end;
  79
  80 end;
  81
  82 end.
  83
  84