GetFormImageで自作のコンポーネントをBITMAPに出力するには？
解決TGraphicControlをベースに自作のコンポーネントをつくりました。
（文字の周りに色をつけるだけのものです。）
ただ、GetFormImageでフォームの画像を取得した内容をみると
このコンポーネントを貼り付けた部分だけ白く表示されてしまいます。
コンポーネント側の作り方で何か宣言をすれば、標準のコンポーネント
のようにGetFormImageで自作コンポーネント部分を表示できるようになるのでしょうか？
アドバイスをお願いします。
普通に作れば普通に表示されます…としかいえません。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
THoge = class(TCustomControl)
private
procedure paint; override;
public
constructor Create(AOwner: TComponent); override;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
Hoge:THoge;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var bmp:TBitmap;
begin
bmp:=TBitmap.Create;
bmp:=GetFormImage;
Canvas.Draw(100,100,bmp);
bmp.Free;
end;
{ THoge }
constructor THoge.Create(AOwner: TComponent);
begin
inherited;
Height:=20;
Width :=100;
end;
procedure THoge.paint;
begin
inherited;
Canvas.TextOut(0,0,'Hoge');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Hoge:=THoge.Create(self);
Hoge.Parent:=Form1;
end;
end.
おっとスミマセン
THoge = class(TGraphicControl)
としてやってください。
早速のお返事ありがとうございます。
やってみます。
あつかましいのですが、下記のソースに至らぬところがあるのでしょうか？
こうしたほうが良いと言うところがあれば是非アドバイスください。
unit ShadowFont;
//
// 縁取り文字を表示するコンポーネントです。
//
//
// 作成 2005/09/22 ROOSTER
//
interface
uses Windows, Messages, SysUtils, Classes, Controls, Graphics, ComCtrls;
type
TShadowFont = class(TGraphicControl)
protected
F_Caption : string;
F_CaptionColor : TColor; // キャプションの色
F_CaptionEdge : TColor; // キャプションのふちの色
F_CaptionEdgeBold : integer; // キャプションのふちの色
F_BackColor : TColor; // 背景色
F_ShowCaption : Boolean; // 文字表示フラグ
F_ShowCaptionEdge : Boolean; // 文字の枠表示フラグ
F_CaptionAlign : TAlign; // 表示位置
F_BorderLine : Boolean; // ボーダー表示
F_BorderWidth : integer; // ボーダーの太さ
F_BorderColor : TColor; // ボーダーの色
procedure CaptionAlign_W ( Value : TAlign);
procedure Caption_W ( Value : string);
procedure CaptionEdge_W ( Value : TColor);
procedure CaptionEdgeBold_W ( Value : integer);
procedure BackColor_W ( Value : TColor);
procedure ShowCaption_W ( Value : Boolean);
procedure ShowCaptionEdge_W ( Value : Boolean);
procedure BorderWidth_W ( Value : integer);
procedure BorderLine_W ( Value : Boolean);
procedure BorderColor_W ( Value : TColor);
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property CaptionAlign : TAlign read F_CaptionAlign write CaptionAlign_W;
property Caption : string read F_Caption write Caption_W;
property ColorCaptionEdge: TColor read F_CaptionEdge write CaptionEdge_W;
property ColorBack : TColor read F_BackColor write BackColor_W;
property CaptionEdgeBold : integer read F_CaptionEdgeBold write CaptionEdgeBold_W;
property ShowCaption : Boolean read F_ShowCaption write ShowCaption_W;
property ShowCaptionEdge : Boolean read F_ShowCaptionEdge write ShowCaptionEdge_W;
property BorderLine : Boolean read F_BorderLine write BorderLine_W;
property BorderWidth : integer read F_BorderWidth write BorderWidth_W;
property BorderColor : TColor read F_BorderColor write BorderColor_W;
property Font;
property ParentFont;
property Enabled;
property Visible;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('user', [TShadowFont]);
end;
//-----------------------------------------------------------------------------
procedure TShadowFont.CaptionAlign_W ( Value : TAlign);
begin
if Value <> F_CaptionAlign then begin
F_CaptionAlign := Value;
Refresh;
end;
end;
procedure TShadowFont.Caption_W ( Value : string);
begin
if Value <> F_Caption then begin
F_Caption := Value;
Refresh;
end;
end;
procedure TShadowFont.CaptionEdge_W ( Value : TColor);
begin
if Value <> F_CaptionEdge then begin
F_CaptionEdge := Value;
Refresh;
end;
end;
procedure TShadowFont.BackColor_W ( Value : TColor);
begin
if Value <> F_BackColor then begin
F_BackColor := Value;
Refresh;
end;
end;
procedure TShadowFont.ShowCaption_W ( Value : Boolean);
begin
if Value <> F_ShowCaption then begin
F_ShowCaption := Value;
Refresh;
end;
end;
procedure TShadowFont.ShowCaptionEdge_W ( Value : Boolean);
begin
if Value <> F_ShowCaptionEdge then begin
F_ShowCaptionEdge := Value;
Refresh;
end;
end;
procedure TShadowFont.CaptionEdgeBold_W ( Value : integer);
begin
if Value <> F_CaptionEdgeBold then begin
F_CaptionEdgeBold := Value;
Refresh;
end;
end;
procedure TShadowFont.BorderWidth_W ( Value : integer);
begin
if Value <> F_BorderWidth then begin
F_BorderWidth := Value;
Refresh;
end;
end;
procedure TShadowFont.BorderLine_W ( Value : Boolean);
begin
if Value <> F_BorderLine then begin
F_BorderLine := Value;
Refresh;
end;
end;
procedure TShadowFont.BorderColor_W ( Value : TColor);
begin
if Value <> F_BorderColor then begin
F_BorderColor := Value;
Refresh;
end;
end;
//-----------------------------------------------------------------------------
constructor TShadowFont.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csFramed, csOpaque];
F_Caption := 'Tadashi.Y';
F_CaptionEdge := $000000;
F_BackColor := clBtnFace;
F_CaptionEdge := clWhite;
F_ShowCaption := True;
F_ShowCaptionEdge := True;
F_CaptionEdgeBold := 4;
F_CaptionAlign := alNone;
F_BorderLine := false;
F_BorderWidth := 1;
F_BorderColor := clBlack;
Width:=64;
Height:=16;
end;
destructor TShadowFont.Destroy;
begin
inherited;
end;
//=============================================================================
procedure TShadowFont.Paint;
procedure DrawText(Image:TBitmap);
var
size:Tsize;
sx,sy:integer;
s:string;
dc:HDC;
Bold:integer;
begin
s:=F_Caption;
Image.Canvas.Font := Font;
Bold:=(F_CaptionEdgeBold) + (ord(F_BorderLine) * (F_BorderWidth div 2));
size:=Image.Canvas.TextExtent(s);
case F_CaptionAlign of
alNone:begin
sx:=Bold;
sy:=Bold;
end;
alTop:begin
sx:=(Image.Width-size.cx) div 2;
sy:=Bold;
end;
alLeft:begin
sx:=Bold;
sy:=(Image.Height-size.cy) div 2;
end;
alRight:begin
sx:=(Image.Width-size.cx)-Bold;
sy:=(Image.Height-size.cy) div 2;
end;
alBottom:begin
sx:=(Image.Width-size.cx)div 2;
sy:=(Image.Height-size.cy)-Bold;
end;
else begin
sx:=(Image.Width-size.cx) div 2;
sy:=(Image.Height-size.cy) div 2;
end;
end;
Image.Canvas.Brush.Style := bsClear;
if F_ShowCaptionEdge then begin
with Image.Canvas do begin
Pen.Color:=F_CaptionEdge;
Pen.Style :=psSolid;
Pen.Width:=F_CaptionEdgeBold;
dc:=Handle;
Windows.BeginPath(dc);
Windows.TextOut(dc,sx,sy,PCHAR(s), Length(s));
Windows.EndPath(dc);
Windows.StrokePath(dc);
Pen.Width:=0;
Windows.TextOut(Handle,sx,sy,PCHAR(s), Length(s));
end;
end
else begin
with Image.Canvas do begin
Pen.Width:=0;
Windows.TextOut(Handle,sx,sy,PCHAR(s), Length(s));
end;
end;
end;
//============================================================================
var
Image: TBitmap;
begin
Image := TBitmap.Create;
try
Image.PixelFormat:=pf32bit;
Image.HandleType:=bmDIB;
Image.Height := Self.Height;
Image.Width := Self.Width;
Image.Canvas.Brush.Color := F_BackColor;
Image.Canvas.Brush.Style := bsSolid;
Image.Canvas.FillRect(ClientRect);
Image.Canvas.Brush.Style := bsClear;
if (F_BorderLine) and (F_BorderWidth<>0) then begin
Image.Canvas.Pen.Width:=F_BorderWidth;
Image.Canvas.Pen.Color := F_BorderColor;
Image.Canvas.Pen.Style := psSolid;
Image.Canvas.Rectangle(0,0,Self.Width, Self.Height);
end;
if F_ShowCaption then begin
DrawText(Image);
end;
Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, Image);
finally
Image.Destroy;
end;
end;
end.
あれ？
教えていただいたやり方で表示しました。
問題は別なところにあるようです。
お騒がせしてすみませんでした。
また質問するかもしれませんので
[解決]にはまだしません。
ありがとうございました。
失礼ながら、アンダースコアの使い方が少し気になりました。
人の勝手なのですが、少しでもPascalの書き方に、ご興味が
あるようでしたら、以下を参照してみてください。
Object Pascal Style Guide
h ttp://community.borland.com/article/0,1410,10280,00.html
× Image.Destroy;
○ Image.Free;
原因はコンポーネントではありませんでした。
はずかしいのでいえません。
お騒がせしました。
ママん さん
みなさん
ありがとうございました。
| ツイート |  |