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