delphi 绘制马赛克（delphi 在屏幕外如何绘图）

本文目录

• delphi 在屏幕外如何绘图
• DELPHI基础教程：Delphi图形图像编程（二）[2]
• delphi chart控件问题
• Delphi中有没有OpenGL现成的控件
• 如何在delphi 中程序 改变图像的尺寸如正比缩小，有控件或功能吗

delphi 在屏幕外如何绘图

以下代码在全屏幕中心绘制一个十字架:
procedure TForm1.Button1Click(Sender: TObject);
var
FullscreenCanvas:TCanvas;
DC:HDC;
begin
DC:=GetDC(0);//取得屏幕的DC，参数0指的是屏备困启幕
FullscreenCanvas := TCanvas.Create;//创建一个CANVAS对象
FullscreenCanvas.Handle := DC; //将画布关联到屏幕句柄，以便能做图
FullscreenCanvas.MoveTo(screen.Width div 2,0);
FullscreenCanvas.LineTo(screen.Width div 2,768);
FullscreenCanvas.MoveTo(0,Screen.Height div 2);
FullscreenCanvas.LineTo(1024,Screen.Height div 2);
end;
//以下代码实现定时在屏幕正中绘一尺雀个十字，一个正方形，一个圆形仿如
procedure TForm1.Timer1Timer(Sender: TObject);

DELPHI基础教程：Delphi图形图像编程（二）[2]

　　另外一个问题是 我们希望得到的是鼠标按钮按下和松开这两点所形成的图形 但OnMouseMove却把鼠标轨迹上各点与起始点所形成的所有图形画在屏幕上 这同样是我们不希望看到的 为了解决这些问题 程序定义了鼠标的三个事件

　　procedure TForm FormMouseDown（Sender: TObject; Button: TMouseButton;

　　Shift: TShiftState; X Y: Integer）

　　begin

　　Drawing := True;

　　Image Canvas MoveTo（X Y）

　　Origin := Point（X Y）

　　MovePt := Origin;

　　OriginPanel Caption := Format（ Origin: （%d %d） ）

　　end;

　　procedure TForm FormMouseUp（Sender: TObject; Button: TMouseButton;

　　Shift: TShiftState; X Y: Integer）

　　begin

　　if Drawing then

　　DrawShape（Origin Point（X Y） pmCopy）

　　Drawing := False;

　　end;

　　procedure TForm FormMouseMove（Sender: TObject; Shift: TShiftState; X

　　Y: Integer）

　　begin

　　if Drawing then

　　begin

　　DrawShape（Origin MovePt pmNotXor）

　　MovePt := Point（X Y）

　　DrawShape（Origin MovePt pmNotXor）

　　end;

　　MovePt用来记录鼠标当前位置 当下次鼠标移动时 就能在上次鼠标绘制的图形上画一个形状 大小一样的图形 并把画笔颜色设置成PmNotXor 使上次绘制的图形颜色变成了屏幕颜色 从而达到 橡皮擦 的效果

　　将画笔 画刷的Style属性设置成用户希望的值 可实现对画笔和画刷风格的选择

　　procedure TForm SetBrushStyle（Sender: TObject）

　　begin

　　with Image Canvas Brush do

　　begin

　　if Sender = SolidBrush then Style := bsSolid

　　else if Sender = ClearBrush then Style := bsClear

　　else if Sender = HorizontalBrush then Style := bsHorizontal

　　else if Sender = VerticalBrush then Style := bsVertical

　　else if Sender = FDiagonalBrush then Style := bsFDiagonal

　　else if Sender = BDiagonalBrush then Style := bsBDiagonal

　　else if Sender = CrossBrush then Style := bsCross

　　else if Sender = DiagCrossBrush then Style := bsDiagCross;

　　end;

　　procedure TForm SetPenStyle（Sender: TObject）

　　begin

　　with Image Canvas Pen do

　　begin

　　if Sender = SolidPen then Style := psSolid

　　else if Sender = DashPen then Style := psDash

　　else if Sender = DotPen then Style := psDot

　　else if Sender = DashDotPen then Style := psDashDot

　　else if Sender = DashDotDotPen then Style := psDashDotDot

　　else if Sender = ClearPen then Style := psClear;

　　end;

　　end;

　　 图像对象概述

　　 TGraphic对象

　　TGraphic对象是TBitmap TIcon Tmetafile对象的基类 如果知道图像的具体类型（ 如位图 图标元文件） 则应将图像贮存在相应类型的对象中（ 如TBitmap TIcon Tmetafile） 否则应该使用可贮存任何图像类型的TPicture对象

　　 TPicture对象

　　TPicture对象可以保存位图 图标或元文件 Graphic属性中包括图像的类型 图像的高度和宽度分别定义在Height Width属性中 调用LoadFromFile方法 可以从文件中装载一幅图像

　　procedure TForm FormCreate（Sender: TObject）

　　begin

　　BitBtn Glyph LoadFromFile（ TARTAN BMP ）

　　end;

　　要保存一个位图 则要用SaveToFile方法 要把图像复制到剪切板 可以调用TClipboard对象的Assign方法

　　 TImage部件

　　TImage部件用以在窗体中显示图像 它的Picture 属性保存着要显示的图像 这是一个TPicture对象 AutoSize Stretch属性是用来调节部件与图像的大小的 当AutoSize 为真值时 TImage部件将根据它所包含的图像的大小来调整自身的大小 当AutoSize为假值时 不论图像有多大 部件将保持设计时的大小 如果部件比图像小 那么只有一部分图像是可见的 当Stretch为真值时 位图像将根据部件的大小调整自身的大小 当部件大小改变时 元文件也做相应变化 Stretch属性对图标没有作用

　　 TBitmap Object（位图对象）

　　位图对象包含一个位图图像 有HBITMAP HPALETE句柄 可自动管理调色板 位图对象也有画布属性 位图的Palette属性用来控制位图的颜色映射 它包括 种可显示的颜色 如果应用程序用前景色绘制位图 Palette 属性的颜色将被加入Windows系统调色板 其它颜色被映射到系统调色板已存在的颜色 如果应用程序用自己的颜色绘制位图 而其它程序已占有系统调色板 位图的颜色将被映射到系统调色板中

　　如果Monochrome属性设置成假 位图将显示成彩色 反之显示成黑白色

　　调用Draw和StretchDraw方法可在画布上绘制位图

　　 图像对象的应用

　　本章例程中 单击（文件|浏览）菜单项 将弹出一个图像浏览窗体 如果用户在窗体中选择文件列表框的图形文件 窗体右上角的图像部件上将出现此文件所代表的图像 若选择 雕刻效果 按钮中检查框 窗体中的加速按钮和位图按钮上将出现位图

　　以下代码是将图像文件装载至图像部件上

　　procedure TImageForm FileListBox Click（Sender: TObject）

　　var

　　FileExt: string;

　　begin

　　FileExt := UpperCase（ExtractFileExt（FileListBox Filename））

　　if （FileExt = BMP ） or （FileExt = ICO ） or （FileExt = WMF ） then

　　begin

　　Image Picture LoadFromFile（FileListBox Filename）

　　Label Caption := ExtractFilename（FileListBox Filename）

　　if （FileExt = BMP ） then

　　begin

　　Label Caption := Label Caption +

　　Format（ （%d x %d） ）

　　ViewForm Image Picture Bitmap := Image Picture Bitmap;

　　ViewAsGlyph（FileExt）

　　end;

　　if FileExt = ICO then Icon := Image Picture Icon;

　　if FileExt = WMF then

　　ViewForm Image Picture Metafile := Image Picture Metafile;

　　end;

　　end;

　　这个过程首先判断文件类型 如果是图像文件 则将图像装载至图像部件上 并在标签上列出文件名称 如果是位图文件 还将显示其大小

delphi chart控件问题

procedure TForm1.Chart1ClickSeries(Sender: TCustomChart;

  Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;

  Shift: 蠢告TShiftState; X, Y: Integer);

begin

  edit1.text:=inttostr(x);

  edit2.text:=inttostr(y);

procedure TForm1.FormCreate(Sender: TObject);

var

  a:integer;

begin

  for a:=0 to 100 do

    chart1.Series.AddXY(a,random(100))

鼠标移动我暂带拆明时办不到,单御侍击曲线的时候显示是可以做到的

Delphi中有没有OpenGL现成的控件

GLPanel也能用，下面是源码，给裤祥大谈野家共享：含纯喊
unit GLPanel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,OpenGL,Printers;
type
TGLPanel = class(TCustomPanel)
private
{ Private declarations }
//DC: HDC;
RC: HGLRC;
procedure initDC;
procedure initGL;
procedure PreparePixelFormat(var DC: HDC);
protected
{ Protected declarations }
FOnPaint:TNotifyEvent;
FOnInit:TNotifyEvent;
FOnPreInit:TNotifyEvent;
FOnResize:TNotifyEvent;
procedure Paint;override;
procedure Resize;override;
procedure WMDestroy(var Msg: TWMDestroy);message WM_DESTROY;
procedure WMCreate(var Msg:TWMCreate); message WM_CREATE;
public
{ Public declarations }
DC: HDC;
constructor Create(Owner:TComponent);override;
procedure SaveToBMPFile(FileName: String);
procedure PrintIt;
published
{ Published declarations }
property Alignment;
property Align;
property DragCursor;
property DragMode;
property Enabled;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnInit:TNotifyEvent read FOnInit write FOnInit;
property OnPreInit:TNotifyEvent read FOnPreInit write FOnPreInit;
property OnResize:TNotifyEvent read FOnResize write FOnResize;
property OnPaint:TNotifyEvent read FOnPaint write FOnPaint;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(’Samples’, );
end;
//---------------------------------------------
constructor TGLPanel.Create;
begin
inherited;
end;
//---------------------------------------------
procedure TGLPanel.WMDestroy(var Msg: TWMDestroy);
begin
wglMakeCurrent(0, 0);
wglDeleteContext(RC);
ReleaseDC(Handle, DC);
end;
//---------------------------------------------------
procedure TGLPanel.initDC;
begin
DC := GetDC(Handle);
PreparePixelFormat(DC);
end;
procedure TGLPanel.initGL;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glEnable(GL_LIGHTING);
glEnable(GL_LIGHT0);
gluPerspective(45.0, self.ClientWidth/self.ClientHeight, 1.0, 500.0);
//glOrtho(-1, 1, -1, 1, -1, 50);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
glEnable(GL_DEPTH_TEST);
glEnable(GL_COLOR_MATERIAL);
glShadeModel(GL_SMOOTH);
gluLookAt(0, 0, 6, 0, 0, 0, 0, 1, 0);
SwapBuffers(DC);
end;
//---------------------------------------------
procedure TGLPanel.PreparePixelFormat(var DC: HDC);
var
PFD : TPixelFormatDescriptor;
ChosenPixelFormat : Integer;
begin
FillChar(PFD, SizeOf(TPixelFormatDescriptor), 0);
with PFD do
begin
nSize := SizeOf(TPixelFormatDescriptor);
nVersion := 1;
dwFlags := PFD_DRAW_TO_WINDOW or
PFD_SUPPORT_OPENGL or
PFD_DOUBLEBUFFER;
iPixelType := PFD_TYPE_RGBA;
cColorBits := 16; // 16位颜色
cDepthBits := 32; // 32位深度缓冲
iLayerType := PFD_MAIN_PLANE;
{ Should be 24, but we must allow for the clunky WKU boxes }
end;
ChosenPixelFormat := ChoosePixelFormat(DC, @PFD);
if ChosenPixelFormat = 0 then
Raise Exception.Create(’ChoosePixelFormat failed!’);
SetPixelFormat(DC, ChosenPixelFormat, @PFD);
end;
procedure TGLPanel.WMCreate(var Msg:TWMCreate);
begin
//在这里做初始化工作
//修改DC的象素格式，使之支持OpenGL绘制
initDC;
RC := wglCreateContext(DC);
if Assigned(FOnInit) then
begin
if (wglMakeCurrent(DC,RC)=false) then
ShowMessage(’wglMakeCurrent:’ + IntToStr (GetLastError));
FOnInit(self);
end;
wglMakeCurrent(DC, RC);
//初始化GL绘制系统
initGL;
end;
//---------------------------------------------------------------------------
procedure TGLPanel.Paint;
begin
//TCustomPanel::Paint();
if Assigned(FOnPaint) then
begin
wglMakeCurrent(DC,RC);
FOnPaint(self);
SwapBuffers(DC);
end;
end;
//---------------------------------------------------------------------------
procedure TGLPanel.Resize;
begin
inherited;
if Assigned(FOnResize) then
begin
wglMakeCurrent(DC,RC);
glViewport(0,0,ClientWidth,ClientHeight);
FOnResize(self);
end;
end;
procedure TGLPanel.SaveToBMPFile(FileName: String);
var BitMap : TBitmap;
begin
Bitmap:= TBitmap.Create;
BitMap.Height := Height;
BitMap.Width := Width;
BringToFront;
Paint;
BitMap.Canvas.CopyRect(ClientRect ,Canvas,ClientRect);
BitMap.SaveToFile(FileName);
//delete BitMap;
end;
procedure TGLPanel.PrintIt;
var
Bitmap:TBitMap;
XPixelsPerInch,YPixelsPerInch:integer;
Rect:TRECT;
PrintDlg:TPrintDialog;
begin
PrintDlg:=TPrintDialog.Create(self);
if PrintDlg.Execute then begin
BitMap := TBitmap.Create;
BitMap.Height:= Height;
BitMap.Width := Width;
BringToFront;
Paint;
BitMap.Canvas.CopyRect(ClientRect,Canvas,ClientRect);
XPixelsPerInch:=GetDeviceCaps(Printer.Handle,LOGPIXELSX);
YPixelsPerInch:=GetDeviceCaps(Printer.Handle,LOGPIXELSY);
Rect.left :=round(0.18*XPixelsPerInch);
Rect.top :=round(0.18*YPixelsPerInch);
//根据需要调整right/bottom可以达到按比例打印或打满整纸等效果
//必要时可使用GetDeviceCaps(Printer.Handle,HORZRES/VERTRES)
//查询相关信息
Rect.right :=BitMap.Width+Rect.left;
Rect.bottom:=BitMap.Height+Rect.right;
Printer.BeginDoc;
Printer.Canvas.CopyRect(Rect,BitMap.Canvas,ClientRect);
Printer.EndDoc;
end; //if(dlg.execute)
PrintDlg.Destroy;
end;
end.

如何在delphi 中程序 改变图像的尺寸如正比缩小，有控件或功能吗

假设目标：把Image1中的图像长宽都缩小到一半后，放入Image2中
方法#1：用Image.Stretch属性
Image2.Stretch
:=
True;
Image2.Width
:=
Image1.Width
div
2;
Image2.Height
:=
Image1.Width
div
2;
Image2.Picture.Assign(
Image1.Picture
);
方法#2：调用Windows
API——StretchBlt
Image2.Width
:=
Image1.Width
div
2;
Image2.Height
:=
Image1.Width
div
2;
StretchBlt(
Image2.Canvas.Handle,
0,
0,
Image2.Width,
Image2.Height,
Image1.Canvas.Handle,
0,
0,
Image1.Width,
Image1.Height,
SRCCOPY
);
如果需要将改变后的图像另存，则直接用Image2.Picture.SaveToFile即可。
点评：方法一简单，方法顷肆雹二功能强，可以准确定位要把原始图像放到目标图像的什么位置，而不是雀帆固定的从左上角到右下角雹轮之间的矩形，还可以由最后一个参数制定绘制方法，各种方法分别是什么功能，可查阅MSDN。