一个超链接Image控件！（For D3,D4,D5,D6)源代码…

(Tmp.PaletteModified) then
begin
if (Tmp.Palette = 0) then
Tmp.PaletteModified := False
else
begin
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
begin
if FDrawing then
ParentForm.Perform(wm_QueryNewPalette, 0, 0)
else
PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
Result := True;
Tmp.PaletteModified := False;
end;
end;
end;
end;

procedure THImage.Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
if FIncrementalDisplay and RedrawNow then
begin
if DoPaletteChange then Update
else Paint;
end;
if Assigned(FOnProgress) then FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;

function THImage.GetCanvas: TCanvas;
var
Bitmap: TBitmap;
begin
if Picture.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Picture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;
if Picture.Graphic is TBitmap then
Result := TBitmap(Picture.Graphic).Canvas;

end;

procedure THImage.SetCenter(Value: Boolean);
begin
if FCenter <> Value then
begin
FCenter := Value;
PictureChanged(Self);
end;
end;

procedure THImage.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;

procedure THImage.SetStretch(Value: Boolean);
begin
if Value <> FStretch then
begin
FStretch := Value;
PictureChanged(Self);
end;
end;

procedure THImage.SetTransparent(Value: Boolean);
begin
if Value <> FTransparent then
begin
FTransparent := Value;
PictureChanged(Self);
end;
end;

procedure THImage.PictureChanged(Sender: TObject);
var
G: TGraphic;
begin
if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
SetBounds(Left, Top, Picture.Width, Picture.Height);
G := Picture.Graphic;
if G <> nil then
begin
if not ((G is TMetaFile) or (G is TIcon)) then
G.Transparent := FTransparent;
if (not G.Transparent) and (Stretch or (G.Width >= Width)
and (G.Height >= Height)) then
ControlStyle := ControlStyle [csOpaque]
else
ControlStyle := ControlStyle - [csOpaque];
if DoPaletteChange and FDrawing then Update;
end
else ControlStyle := ControlStyle - [csOpaque];
if not FDrawing then Invalidate;
end;

function THImage.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True;
if not (csDesigning in ComponentState) or (Picture.Width > 0) and
(Picture.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := Picture.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := Picture.Height;
end;
end;

procedure THImage.CMMouseLeave(var Message:TMessage);
begin
inherited;
if FPicture<>FPictureNormal then
Picture.Assign(FPictureNormal);
end;

procedure THImage.CMMouseEnter(var Message: TMessage);
begin
inherited;
if FPicture<>FPictureHot then
Picture.Assign(FPictureHot);
end;

procedure Register;
begin
RegisterComponents(''''Lee'''', [THImage]);
end;

end.

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有