关于 Bitmap.Handle 的问题。(300分)

我在 DLL 里写了个函数。
procedure GetTitle(Bitmap : HBITMAP; Var Color : TColor);stdcall;
begin
Mbitmap.Handle:=Bitmap;
Mbitmap.Canvas.Brush.Color := Clblue;
Mbitmap.Canvas.Font.Color := clWhite;
Mbitmap.Canvas.FillRect(Mbitmap.Canvas.ClipRect);
Mbitmap.Canvas.Font.Size := 11;
Mbitmap.Canvas.Font.Style := [fsBold];
Mbitmap.Canvas.FillRect(Rect(0,0,50,10));
Mbitmap.Canvas.TextOut(10,5,'时间');
end;

initialization
Mbitmap:=Tbitmap.Create;
finalization
Mbitmap.Free;
end.

在可执行程序中如下调用。
var
TempColor : TColor;
TempBitmap : Tbitmap;
begin
TempBitmap := Tbitmap.Create;
TempBitmap.Width := 300;
TempBitmap.Height := 60;
TempBitmap.Canvas.Brush.Color := clblue;
TempBitmap.Canvas.FillRect(TempBitmap.Canvas.ClipRect);

GetTitle(TempBitmap.Handle,TempColor);

image1.Picture.Bitmap.Canvas.Draw(0,0,TempBitmap);

TempBitmap.Free;

Panel22.Color := clred;
end;

可不知道为什么 这样执行就是没有结果。
似乎 TempBitmap 是空的 。
但是 SaveToFile 还能看到图。

如果在 image1.Picture.Bitmap.Canvas.Draw(0,0,TempBitmap);
前把 TempBitmap SAVE 再 Load 一下就一切正常了。
十分不解。

晕了 还没人回答我的问题..........

还没人..........

procedure GetTitle(Bitmap : HBITMAP; Var Color : TColor);stdcall;
改为
procedure GetTitle(var Bitmap : HBITMAP; Var Color : TColor);stdcall;
请记住,返回值赋值给Bitmap

initialization
Mbitmap:=Tbitmap.Create;

把下面的去掉.您的free了,函数那有返回值
finalization
Mbitmap.Free;

HBITMAP 只上个 句丙 而且是不变的啊~

把image1.Picture.Bitmap.Canvas.Draw(0,0,TempBitmap);
修改为 image1.Canvas.Draw(0,0,TempBitmap);

以下是我测试代码，楼主也可以到以下地址下载：
地址：ftp.mlfjnp.com
帐户和密码为：dfw

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
procedure GetTitle(Bitmap : TBITMAP; Var Color : TColor);
begin
bitmap.Canvas.Brush.Color := Clblue;
bitmap.Canvas.Font.Color := clWhite;
bitmap.Canvas.FillRect(bitmap.Canvas.ClipRect);
bitmap.Canvas.Font.Size := 11;
bitmap.Canvas.Font.Style := [fsBold];
bitmap.Canvas.FillRect(Rect(0,0,80,80));
bitmap.Canvas.TextRect(Rect(0,0,80,80),20,0,'时间');
end;

var
TempColor : TColor;
TempBitmap : Tbitmap;
begin
TempBitmap := Tbitmap.Create;
TempBitmap.Width := 360;
TempBitmap.Height := 100;
TempBitmap.Canvas.Brush.Color := clblue;
TempBitmap.Canvas.FillRect(TempBitmap.Canvas.ClipRect);

GetTitle(TempBitmap,TempColor);

image1.Canvas.Draw(0,0,TempBitmap);

TempBitmap.Free;

end;

end.

chnplzh 先生您好~
我实验了你的代码。如果全在可执行程序中通过~
如果在DLL 中 我设置不了字体~~~
所有的 赋值 操作都会错误，内存地址错误 0x00000000 .
但是 TEXTOUT FillRect 什么的都可以。

读那些值也可以，

如果可以的话，能否将你的动态库源代码上传到我的ftp上面？我做进一步测试。
我的e-mail: chnplzh@163.com

QQ 也告诉我.........
我把我所有代码全给你。

我的 3860040

可执行文件代码
---------------------------------------
unit Main_Unit;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
Const
LoadMineFileError = 'Mine01, 载入插件 "%s" 时出错, 文件不存在 或 非标准 Win32 格式文件。';
MineFileTypeError = 'Mine02, "%s" 不符合标准插件格式。';
type
TRenApplication = procedure(ANewApplicationHandle: THandle);stdcall;
TGetTitle = procedure(Bitmap : Tbitmap; Var Color : TColor);stdcall;
var
DllHandle : THandle;
Tempprocedure : TRenApplication;
GetTitle : TGetTitle;
FileName : string;

TempColor : TColor;
TempBitmap : Tbitmap;
begin
FileName := ExtractFilePath(Paramstr(0))+'MYDll.dll';
DllHandle := LoadLibrary(pchar(FileName));

if DllHandle < 1 then
begin
Raise Exception.Create(format(LoadMineFileError,[FileName]));
end
else
begin
@Tempprocedure := GetProcAddress(DllHandle, 'RenApplication');
@GetTitle := GetProcAddress(DllHandle, 'GetTitle');
if (@Tempprocedure=nil) or (@GetTitle=nil) then
begin
Raise Exception.Create(format(MineFileTypeError,[FileName]));
end
else
begin
Tempprocedure(Application.Handle);

TempBitmap := Tbitmap.Create;
TempBitmap.Width := 360;
TempBitmap.Height := 100;
TempBitmap.Canvas.Brush.Color := clblue;
TempBitmap.Canvas.FillRect(TempBitmap.Canvas.ClipRect);

GetTitle(TempBitmap,TempColor);

image1.Canvas.Draw(0,0,TempBitmap);

TempBitmap.Free;
end;
end;
end;

end.



DLL 代码
------------------------------------------------------
library MYDll;

uses
SysUtils, Windows, Classes, StrUtils, Forms, Dialogs, Graphics;

const
TwTime = 80;
TwLs = 120;
TwValue = 60;

var
Oldapp : THandle;

procedure DLLEntryPoint(dwReason: DWord);
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
Oldapp:=application.Handle;
end;
DLL_PROCESS_DETACH:
begin
application.Handle:=Oldapp;
end;
end;
end;

procedure RenApplication(ANewApplicationHandle: THandle);stdcall;
begin
Application.Handle := ANewApplicationHandle;
end;

procedure GetTitle(Bitmap : Tbitmap; Var Color : TColor);stdcall;
begin
SetTextColor(bitmap.Canvas.Handle, ColorToRGB(clRed));
bitmap.Canvas.Font.Style := [fsBold];
bitmap.Canvas.TextOut(10,5,'比赛时间');
end;

exports
RenApplication, GetTitle;

begin
DllProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

文件已经上传到 FTP 服务器。

兄弟 人呢？

对不起，准备开会呢，晚上回家帮你解决。

好的 麻烦您了。

带包编译应该和可执行文件差不多

可是 上边代码的 运行到 bitmap.Canvas.Font.Style := [fsBold]; 一定出错~

..............
image1.Canvas.Draw(0,0,TempBitmap);
image1.Repaint;
...........

41426277 你的办法无效