关于Label上画图(200分)

  • 主题发起人 主题发起人 流水寿司
  • 开始时间 开始时间

流水寿司

Unregistered / Unconfirmed
GUEST, unregistred user!
我先在Label上画了图标,然后在OnClick事件中设置Label背景的颜色,但是这样画上的图标也没了,我在Form上的OnPaint事件中写了重画图标的代码也没用,感觉好像是OnPaint事件触发后才对Label的背景赐值的.请教有没有画上图标之后又能改颜色,但仍保留图标的方法?
 
最好续承label再建一个新的控件,加多一个加载图像的属性这样不难实现呀,自己试试,如果真的不会的话,我可以帮你写个这样的控件
 
你的方法在Form的onpaint中是实现不了的,
解决方法:
1. 写个新的label控件,(建议)
2. 替换label1的 WindowProc 方法;
 
好像自己写控件也会碰到相同的问题,早上看到两位的回答,于是尝试自己写一个(第一次写),参考了网上的资料,现在贴出来,但是画不上图案(画上马上就消失了),还望指教/
unit ImgLabel;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics;

type
TImgLabel = class(TLabel)
private
{ Private declarations }
FPicture:TBitmap;
FPicLeft:Integer;
FPicTop:Integer;
FPicWidth:Integer;
FPicHeight:Integer;
procedure SetPicture(Value: TBitmap);
procedure SetPicWidth(Value: Integer);
procedure SetPicHeight(Value: Integer);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
property PicLeft:Integer read FPicleft write FPicleft default 0;
property PicTop:Integer read FPicTop write FPicTop default 0;
property PicWidth:Integer read FPicWidth write FPicWidth default 0;
property PicHeight:Integer read FPicHeight write SetPicHeight default 0;
property Picture:TBitmap read FPicture write SetPicture;
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TImgLabel]);
end;


procedure TImgLabel.SetPicHeight(Value: Integer);
begin
if Value<>0 then
begin
FPicture.Height:=Value;
FPicHeight:=Value;
end;
end;

procedure TImgLabel.SetPicture(Value: TBitmap);
begin
if (PicWidth=0) or (PicHeight=0) then exit;
FPicture.Assign(value);
self.Canvas.Draw(fpicleft,FPicTop,FPicture);
Invalidate;
end;

procedure TImgLabel.SetPicWidth(Value: Integer);
begin
if Value<>0 then
begin
FPicture.Width:=Value;
FPicWidth:=Value;
end;
end;

constructor TImgLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPicture:=TBitmap.Create;
end;
end.
 
缺少paint方法
 
敢问Paint方法如何写?Label好像要来没有Paint事件.
 
我从网上找了一个,它是从TPaintBox继承的
unit ZLabelImage;

interface

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


type
TXAlign = (alXNone, alXLeft, alXRight, alXCenter);
TYAlign = (alYNone, alYTop, alYBottom, alYCenter);


type
TZLabelImage = class(TPaintBox)
private
FCaption: String;
FPicture: TBitmap;
FXPicture: Integer;
FYPicture: Integer;
FXCaption: Integer;
FYCaption: Integer;
FCaptionXAlignment: TXAlign;
FCaptionYAlignment: TYAlign;
FPictureXAlignment: TXAlign;
FPictureYAlignment: TYAlign;
procedure SetPicture(Value: TBitmap);
procedure SetXPicture(Value: Integer);
procedure SetYPicture(Value: Integer);
procedure SetCaption(Value: String);
procedure SetXCaption(Value: Integer);
procedure SetYCaption(Value: Integer);
procedure SetCaptionXAlignment(Value: TXAlign);
procedure SetCaptionYAlignment(Value: TYAlign);
procedure SetPictureXAlignment(Value: TXAlign);
procedure SetPictureYAlignment(Value: TYAlign);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Caption: String read FCaption write SetCaption;
property XCaption: Integer read FXCaption write SetXCaption;
property YCaption: Integer read FYCaption write SetYCaption;
property CaptionXAlignment: TXAlign read FCaptionXAlignment write SetCaptionXAlignment;
property CaptionYAlignment: TYAlign read FCaptionYAlignment write SetCaptionYAlignment;
property Picture: TBitmap read FPicture write SetPicture;
property XPicture: Integer read FXPicture write SetXPicture;
property YPicture: Integer read FYPicture write SetYPicture;
property PictureXAlignment: TXAlign read FPictureXAlignment write SetPictureXAlignment;
property PictureYAlignment: TYAlign read FPictureYAlignment write SetPictureYAlignment;
property OnPaint;
end;

procedure Register;

implementation

{$R ZLABELIMAGE.DCR}


procedure Register;
begin
RegisterComponents('AZ', [TZLabelImage]);
end;

constructor TZLabelImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPicture := TBitmap.Create;
FCaption := Self.Name;
SetXPicture(2);
SetXPicture(2);
SetXCaption(0);
SetYCaption(0);
end;


procedure TZLabelImage.Paint;
var XP, XC, YP, YC: Integer;
begin
inherited;
XP := 0;
YP := 0;
XC := 0;
YC := 0;
With Self.Canvas do
begin
Brush.Color := Self.Color;
Font := Self.Font;
FillRect(Self.ClientRect);

Case FPictureXAlignment of
alXNone: XP := FXPicture;
alXLeft: XP := 0;
alXRight: XP := Self.Width - FPicture.Width;
alXCenter: XP := (Self.Width div 2) - (FPicture.Width) div 2;
end;

Case FPictureYAlignment of
alYNone: YP := FYPicture;
alYTop: YP := 0;
alYBottom: YP := Self.Height - FPicture.height;
alYCenter: YP := (Self.Height div 2) - (FPicture.Height div 2);
end;

Draw(XP, YP, FPicture);

Case FCaptionXAlignment of
alXNone: XC := FXCaption;
alXLeft: XC := 0;
alXRight: XC := Self.Width - TextWidth(FCaption);
alXCenter: XC := (Self.Width div 2) - (TextWidth(FCaption) div 2);
end;

Case FCaptionYAlignment of
alYNone: YC := FYCaption;
alYTop: YC := 0;
alYBottom: YC := Self.Height - TextHeight(FCaption);
alYCenter: YC := (Self.Height div 2) - (TextHeight(FCaption) div 2);
end;
Brush.Style := bsClear;
TextOut(XC, YC, FCaption);
end;
end;

procedure TZLabelImage.SetPicture(Value: TBitmap);
begin
FPicture.Assign(Value);
Self.Repaint;
end;

procedure TZLabelImage.SetXPicture(Value: Integer);
begin
FXPicture := Value;
Self.Repaint;
end;

procedure TZLabelImage.SetYPicture(Value: Integer);
begin
FYPicture := Value;
Self.Repaint;
end;

procedure TZLabelImage.SetCaption(Value: String);
begin
FCaption := Value;
Self.Repaint;
end;

procedure TZLabelImage.SetXCaption(Value: Integer);
begin
FXCaption := Value;
Self.Repaint;
end;

procedure TZLabelImage.SetYCaption(Value: Integer);
begin
FYCaption := Value;
Self.Repaint;
end;

procedure TZLabelImage.SetCaptionXAlignment(Value: TXAlign);
begin
FCaptionXAlignment := Value;
Self.Repaint;
end;

procedure TZLabelImage.SetCaptionYAlignment(Value: TYAlign);
begin
FCaptionYAlignment := Value;
Self.Repaint;
end;

procedure TZLabelImage.SetPictureXAlignment(Value: TXAlign);
begin
FPictureXAlignment := Value;
Self.Repaint;
end;

procedure TZLabelImage.SetPictureYAlignment(Value: TYAlign);
begin
FPictureYAlignment := Value;
Self.Repaint;
end;
 
procedure Paint; override;
这么写就行了
 
感谢各位的解答,按照tgdjw贴出来的例子,我终于自己做了个Label,把分数一半给tgdjw,剩下的平分给另外解答问题的四位朋友,再次表示感谢.
 
后退
顶部