FAQ VCL
Графика

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как изменить шрифт и выравнивание в заголовке формы?

uses
  {...,} ImgList;

procedure TForm1.Button1Click(Sender: TObject);
var
  bm : TBitmap;
  il : TImageList;
begin
   bm := TBitmap.Create;
   bm.LoadFromFile( 'C:\Test.bmp' );
   il := TImageList.CreateSize( bm.Width, bm.Height );
   il.DrawingStyle := dsTransparent;
   il.Masked := true;
   il.AddMasked( bm, clBlack );
   il.Draw( Form1.Canvas, 0, 0, 0 );
   bm.Free;
   il.Free;
end;


Как преобразовать BMP в WMF?

procedure ConvertBMP2WMF(const BMPFileName, WMFFileName: TFileName);
var
  MetaFile: TMetafile;
  MetaFileCanvas: TMetafileCanvas;
  Bitmap: TBitmap;
begin
   Metafile := TMetaFile.Create;
   Bitmap := TBitmap.Create;
   try
      Bitmap.LoadFromFile( BMPFileName );
      MetaFile.Height := Bitmap.Height;
      MetaFile.Width  := Bitmap.Width;
      MetaFileCanvas := TMetaFileCanvas.Create( MetaFile, 0 );
      MetaFileCanvas.Draw( 0, 0, Bitmap );
      MetaFileCanvas.Free;
      MetaFile.SaveToFile( WMFFileName );
   finally
      Bitmap.Free;
      MetaFile.Free;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ConvertBMP2WMF( 'C:\Test.bmp', 'C:\Test.wmf' );
end;


Как преобразовать WMF в BMP?

procedure ConvertWMF2BMP(const WMFFileName, BMPFileName: TFileName);
var
  MetaFile : TMetafile;
  Bitmap : TBitmap;
begin
   Metafile := TMetaFile.Create;
   Bitmap := TBitmap.Create;
   try
      MetaFile.LoadFromFile( WMFFileName );
      with Bitmap do
      begin
         Height := Metafile.Height-1;
         Width  := Metafile.Width-1;
         Canvas.Draw( 0, 0, MetaFile );
         SaveToFile( BMPFileName );
      end;
   finally
      Bitmap.Free;
      MetaFile.Free;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ConvertWMF2BMP( 'C:\Test.wmf', 'C:\Test.bmp' );
end;


Как преобразовать BMP в EMF (Enhanced Metafile)?

procedure ConvertBMP2EMF(const BMPFileName, EMFFileName: TFileName);
var
  Metafile: TMetafile;
  MetaCanvas: TMetafileCanvas;
  Bitmap: TBitmap;
begin
   Metafile := TMetaFile.Create;
   try
      Bitmap := TBitmap.Create;
      try
         Bitmap.LoadFromFile( BMPFileName );
         Metafile.Height := Bitmap.Height;
         Metafile.Width := Bitmap.Width;
         MetaCanvas := TMetafileCanvas.Create( Metafile, 0 );
         try
            MetaCanvas.Draw( 0, 0, Bitmap );
         finally
            MetaCanvas.Free;
         end;
      finally
         Bitmap.Free;
      end;
      Metafile.SaveToFile( EMFFileName );
   finally
      Metafile.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ConvertBMP2EMF( 'C:\Test.bmp', 'C:\Test.emf' );
end;


Как вывести надпись на рабочий стол?

procedure WriteDC(s:string);
var
  c: TCanvas;
begin
   c := TCanvas.Create;
   // c.Brush.Color := clBlue; - цвет фона, если не используется стиль bsClear
   c.Brush.Style := bsClear;
   c.Font.Color := clYellow;
   c.Font.Name := 'Fixedsys';
   c.Handle := GetDC( GetWindow( GetDesktopWindow, GW_OWNER ) );
   c.TextOut( Screen.Width div 2 - c.TextWidth( s ) div 2, Screen.Height div 2, s );
   c.free;
end;


Как использовать встроенные в Windows иконки в своём приложении?

// Константы IDI_ определены в модуле Windows

procedure TForm1.Button1Click(Sender: TObject);
const
  IDI: array[0..6] of PChar =
       (IDI_APPLICATION, IDI_ERROR, IDI_QUESTION,
        IDI_WARNING, IDI_INFORMATION, IDI_WINLOGO, IDI_SHIELD);
var
  DC: HDC;
  Icon: HICON;
begin
   DC := GetWindowDC(Handle);
   Icon := LoadIcon(0, IDI[0]);
   DrawIcon(DC, 5, 25, Icon);
   ReleaseDC(Handle, DC);
end;


Как изменить фоновый цвет текста?

procedure TForm1.Button1Click(Sender: TObject);
var
  OldTextColor: TColorRef;
  OldBkColor: TColorRef;
  OldBkMode: Integer;
begin
   OldTextColor := SetTextColor( Form1.Canvas.Handle, RGB( 0, 0, 255 ) );
   OldBkColor := SetBkColor( Form1.Canvas.Handle, RGB( 255, 0, 0 ) );
   OldBkMode := SetBkMode( Form1.Canvas.Handle, OPAQUE );
   TextOut( Form1.Canvas.Handle, 100, 100, 'Синий текст на красном фоне', 27 );
   SetBkMode( Form1.Canvas.Handle, OldBkMode );
   SetBkColor( Form1.Canvas.Handle, OldBkColor );
   SetTextColor( Form1.Canvas.Handle, OldTextColor );
end;


Как сохранить содержимое TPaintBox в BMP файл?

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
  Source: TRect;
  Dest: TRect;
begin
   Bitmap := TBitmap.Create;
   try
      with Bitmap do
      begin
         Width := PaintBox1.Width;
         Height := PaintBox1.Height;
         Dest := Rect( 0, 0, Width, Height );
      end;
      with PaintBox1 do
         Source := Rect( 0, 0, Width, Height );
      Bitmap.Canvas.CopyRect( Dest, PaintBox1.Canvas, Source );
      Bitmap.SaveToFile( 'C:\MYFILE.BMP' );
   finally
      Bitmap.Free;
   end;
end;


Как скопировать обои рабочего стола в Canvas?

procedure TForm1.Button1Click(Sender: TObject);
begin
   PaintDesktop( Form1.Canvas.Handle );
end;


Как получить цвет пикселя под курсором мыши?

function GetColorPixel: TColor;
var
 DC: HDC;
 Cur: TPoint;
 ColorValue: Cardinal;
begin
   DC := GetDC( 0 );
   GetCursorPos( Cur );
   ColorValue := GetPixel( DC, Cur.X, Cur.Y );
   Result := ColorValue;
   ReleaseDC( 0, DC );
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Color := GetColorPixel;
end;

При использовании материала - ссылка на сайт обязательна