:: 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;
|
Как получить цвет пикселя под курсором мыши?
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;
|
При использовании материала - ссылка на сайт обязательна
|
|