请教:关于在图片上输出文字(300分)

  • 主题发起人 主题发起人 东兰梦舞
  • 开始时间 开始时间
var
Bmp1,Bmp2 :TBitmap;
begin
Bmp1 :=TBitmap.Create;
Bmp1.LoadFromFile('F:/图象/BMP2/[04].bmp');
Bmp2 :=TBitmap.Create;
Bmp2.LoadFromFile('F:/图象/BMP2/[11].bmp');
//逻辑与:用SRCAND;逻辑或:用SRCPAINT
BitBlt

(Bmp1.Canvas.Handle,0,0,Bmp1.Width,Bmp1.Height,Bmp2.Canvas.Handle,0,0,SRCPAINT);
Image1.Picture.Bitmap.Assign(Bmp1);
Bmp1.Free;
Bmp2.Free;
end;
 
var
temp: TBitmap;
i:integer;
BEGIN
temp:=TBitmap.Create;
try
temp.Height :=400;
temp.Width :=600;
temp.Transparent:=True;
temp.Canvas.Brush.Color:=clWindow;
temp.canvas.Font.Size:=12;
temp.Canvas.Font.Name:='宋体';
temp.Canvas.Font.Color:=clred;
for i:=0 to memo1.lines.count-1 do
temp.Canvas.TextOut (10,20*i,memo1.lines.strings);
FORM1.Image1.Picture.Assign(temp);
Finally
temp.Destroy;
End;
end;
 
//速度有点慢 你可用FastBmp
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
PaintBox1: TPaintBox;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure PaintBox1Paint(Sender: TObject);
procedure Memo1Change(Sender: TObject);
private
bmp: TBitmap;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
DoubleBuffered := true;
bmp := TBitmap.Create;
bmp.Width := 200;
bmp.Height := 255;
with bmp.Canvas do
begin
for i := 0 to 255 do
begin
Pen.Color := rgb(i, i, i);

MoveTo(0, i);
lineTo(200, i);

end;

end;

Image1.Picture.Bitmap.Assign(bmp);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
freeandnil(bmp)
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
tempbmp, temp2: TBitmap;
i, j: integer;
c: Tcolor;
begin
tempbmp := TBitmap.Create;
tempbmp.Width := Memo1.Width - 10;
tempbmp.Height := Memo1.Height - 10;
tempbmp.Transparent := true;
Memo1.PaintTo(tempbmp.Canvas, -1, -1);
temp2 := TBitmap.Create;
temp2.Assign(bmp);



for i := 0 to tempbmp.Width do
for j := 0 to tempbmp.Height do
if tempbmp.Canvas.Pixels[i, j] = clblack then
begin
c := temp2.Canvas.Pixels[i, j];
if c > $888888 then
temp2.Canvas.Pixels[i, j] := temp2.Canvas.Pixels[i, j] - $888888
else
temp2.Canvas.Pixels[i, j] := temp2.Canvas.Pixels[i, j] + $888888
end;

PaintBox1.Canvas.Draw(1, 1, temp2);
FreeAndNil(tempbmp);
FreeAndNil(temp2);
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
PaintBox1.Repaint;
end;

end.

 
to wqhatnet:
谢谢帮忙。但是你的方法是不可行的。我的图片不知道是什么色的,现在没办法确定字色,如果字色定为黑,背景也黑,两个图合并后,字还是不可见的。

to hfghfghfg:
谢谢。你的方法倒是可以的,但效率太低了,呵呵,我的这个功能是用在聊天程序中的。

再等一天没有更好的答案就结帐。谢谢大家了。
 
作者?: yostgxf
标题?: jpeg文件,图片合并
关键字:
分类?: 个人专区
密级?: 公开
(评分: , 回复: 0, 阅读: 10) »»
uses jpeg, ExtCtrls;
var
JPEGImage: TJPEGImage;
tmpImage1, tmpImage2, tmpImage3 :TImage;
ARect :TRect;
AWidth, AHeight :integer;
begin
DoubleBuffered:=true;
tmpImage1 := TImage.Create(Self);
tmpImage2 := TImage.Create(Self);
tmpImage3 := TImage.Create(Self);
tmpImage3.Parent:=self;
tmpImage1.AutoSize:=true;
tmpImage2.AutoSize:=true;

//先读入jpeg格式的图片
JPEGImage := TJPEGImage.Create;
JPEGImage.LoadFromFile('你读入的文件1');
tmpImage1.Picture.Bitmap.Assign(JPEGImage);
JPEGImage.LoadFromFile('你读入的文件2');
tmpImage2.Picture.Bitmap.Assign(JPEGImage);
AWidth := tmpImage1.Width;
AHeight:= tmpImage1.Height;
tmpImage1.AutoSize:=false;
//并排排列
tmpImage3.Width:=tmpImage1.Width+tmpImage2.Width;
tmpImage3.Height:=tmpImage1.Height;
ARect:=Rect(AWidth, 0, AWidth+tmpImage2.Width, AHeight);
//上下排列
tmpImage3.Height:=tmpImage1.Height+tmpImage2.Height;
tmpImage3.Width:=tmpImage1.Width;
ARect:=Rect(0, AHeight, AWidth, AHeight+tmpImage2.Height);

//合并后的图片放在tmpImage1中
tmpImage3.Canvas.CopyRect(tmpImage1.ClientRect, tmpImage1.Canvas, tmpImage1.ClientRect);
tmpImage3.Canvas.CopyRect(ARect, tmpImage2.Canvas, tmpImage2.ClientRect);
JPEGImage.Assign(tmpImage3.Picture.Bitmap);
tmpImage1.Free;
tmpImage2.Free;

JPEGImage.Compress;
JPEGImage.SaveToFile('你保存的文件');

JPEGImage.Free;
end;
 
东兰梦舞,
你可以用 一个 fastbmp
速度可以快几十倍
 
多人接受答案了。
 
后退
顶部