interface

uses Windows, Messages, SysUtils, Classes, Graphics;

function BitsProPixel: Integer;
procedure DrawBitmap(drCanvas: TCanvas; drBitmap: TBitmap; drRect: TRect);
procedure Line(drwCanvas: TCanvas; x1, y1, x2, y2: Integer);
function GetIcon(fn: string; flag: Integer): HICON;

implementation

function BitsProPixel: Integer;
var dc: HDC;

begin
dc:=GetDC(0);
result:=GetDeviceCaps(dc, BITSPIXEL);
ReleaseDC(0, dc);
end;

procedure DrawBitmap(drCanvas: TCanvas; drBitmap: TBitmap; drRect: TRect);
var

Info: PBitmapInfo;
Image: Pointer;

{$IFDEF WIN32}
InfoSize: DWord;
ImageSize: DWord;
{$ELSE}
InfoSize: Integer;
ImageSize: Longint;
{$ENDIF}

begin

with drBitmap do
begin

   GetDIBSizes(Handle, InfoSize, ImageSize);

   {$IFDEF WIN32}
   Info := AllocMem(InfoSize);
   {$ELSE}
   Info := MemAlloc(InfoSize);
   {$ENDIF}

   try
   {$IFDEF WIN32}
   Image := AllocMem(ImageSize);
   {$ELSE}
   Image := MemAlloc(ImageSize);
   {$ENDIF}

   try
   GetDIB(Handle, Palette, Info^, Image^);

   with Info^.bmiHeader, drRect do
      StretchDIBits(drCanvas.Handle, Left, Top, Right-Left,
                            Bottom-Top, 0, 0, biWidth, biHeight, Image, Info^,
                            DIB_RGB_COLORS, SRCCOPY);

   finally
      FreeMem(Image, ImageSize);
   end;

   finally
      FreeMem(Info, InfoSize);
   end;

end;

end;

procedure Line(drwCanvas: TCanvas; x1, y1, x2, y2: Integer);
begin
   drwCanvas.MoveTo(x1, y1);
   drwCanvas.LineTo(x2, y2);
end;

function GetIcon(fn: string; flag: Integer): HICON;
var sfi: TSHFileInfo;
    SHGFI_FLAG: LongInt;

begin
result:=0;

case flag of
0: SHGFI_FLAG:=SHGFI_SMALLICON;   //kleines Icon
1: SHGFI_FLAG:=SHGFI_LARGEICON;   //grosses Icon
2: SHGFI_FLAG:=SHGFI_SMALLICON or SHGFI_LINKOVERLAY; //ShortCut Icon
3: SHGFI_FLAG:=SHGFI_LARGEICON or SHGFI_LINKOVERLAY; //ShortCut Icon
4: SHGFI_FLAG:=SHGFI_SMALLICON or SHGFI_SELECTED;    //selektiertes Icon
5: SHGFI_FLAG:=SHGFI_LARGEICON or SHGFI_SELECTED;    //selektiertes Icon
end;

SHGetFileInfo(PChar(fn), 0, sfi, sizeof(sfi), (SHGFI_ICON or SHGFI_FLAG));

if sfi.hIcon <> 0 then result:=sfi.hIcon;
end;

end.

Zurück zur Hauptseite