FAQ VCL
Графика

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

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

:: MVP ::

:: RSS ::

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

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

uses
  {...,} ImgList;

procedure TForm1.Button1Click(Sender: TObject);
var
  bm : TBitmap;
  il : TImageList;
begin
  bm := TBitmap.Create;
  try
    bm.LoadFromFile('C:\Test.bmp');
    il := TImageList.CreateSize(bm.Width, bm.Height);

    try
      il.DrawingStyle := dsTransparent;
      il.Masked := True;
      il.AddMasked(bm, clBlack);
      il.Draw(Form1.Canvas, 0, 0, 0);
    finally
      il.Free;
    end;
  finally
    bm.Free;
  end;
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;
  try
    // 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);
  finally
    c.free;
  end;
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);
  try
    Icon := LoadIcon(0, IDI[0]);
    DrawIcon(DC, 5, 25, Icon);
  finally
    ReleaseDC(Handle, DC);
  end;
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);
  try
    GetCursorPos(Cur);
    ColorValue := GetPixel(DC, Cur.X, Cur.Y);
    Result := ColorValue;
  finally
    ReleaseDC(0, DC);
  end;
end;

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

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