关于 Bitmap.Handle 的问题。 找速达物业管理软件
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 一下就一切正常了。
十分不解。
2楼: 晕了 还没人回答我的问题.......... 如金蝶财务软件试用版
3楼: 还没人..........
4楼: 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;
5楼: HBITMAP 只上个 句丙 而且是不变的啊~
6楼: 把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.
进销存软件版7楼: chnplzh 先生您好~
我实验了你的代码。如果全在可执行程序中通过~
如果在DLL 中 我设置不了字体~~~
所有的 赋值 操作都会错误，内存地址错误 0x00000000 .
但是 TEXTOUT FillRect 什么的都可以。
8楼: 读那些值也可以，
9楼: 如果可以的话，能否将你的动态库源代码上传到我的ftp上面？我做进一步测试。
我的e-mail: chnplzh@163.com
10楼: QQ 也告诉我.........
我把我所有代码全给你。
11楼: 我的 3860040
12楼: 可执行文件代码
---------------------------------------
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. 如用友u8财务软件下载
13楼: 文件已经上传到 FTP 服务器。
进销存软件版14楼: 兄弟 人呢？
15楼: 对不起，准备开会呢，晚上回家帮你解决。
16楼: 好的 麻烦您了。
17楼: 带包编译应该和可执行文件差不多
18楼: 可是 上边代码的 运行到 bitmap.Canvas.Font.Style := [fsBold]; 一定出错~
19楼: ..............
image1.Canvas.Draw(0,0,TempBitmap);
image1.Repaint;
...........
20楼: 41426277 你的办法无效
进销存软件版21楼: 5555555555 问题还没解决~
22楼: 问题解决了........... 如速达物业管理软件
联系我们
