Einzelnen Beitrag anzeigen

Robert Marquardt
(Gast)

n/a Beiträge
 
#5

Re: EIn picture im image öfter vorkommen lassen

  Alt 25. Jul 2005, 05:55
Da gibt es einen Trick.
Delphi-Quellcode:
unit tiled;

interface

uses
  Windows, Classes, Controls, Graphics, ExtCtrls;

type
  TTiledImage = class(TImage)
  private
    FTiled: Boolean;
    FBmp: TBitmap;
    procedure SetTiled(const Value: Boolean);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property AutoSize default False;
    property Tiled: Boolean read FTiled write SetTiled default True;
  end;

procedure Register;

implementation

constructor TTiledImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoSize := False;
  FTiled := True;
  FBmp := TBitmap.Create;
end;

type
  TGCE = class(TGraphicControl);

procedure TTiledImage.Paint;
var
  wx, ix, wy, iy: Integer;
begin
  if Tiled then
  begin
    if csDesigning in ComponentState then
      with TGCE(Self).Canvas do
      begin
        Pen.Style := psDash;
        Brush.Style := bsClear;
        Rectangle(0, 0, Width, Height);
      end;
    FBmp.Width := Width;
    FBmp.Height := Height;
    if Assigned(Picture) and Assigned(Picture.Graphic) then
    begin
      wx := Width div Picture.Graphic.Width;
      wy := Height div Picture.Graphic.Height;
      for ix := 0 to wx do
        for iy := 0 to wy do
          FBmp.Canvas.Draw(ix * Picture.Graphic.Width,
              iy * Picture.Graphic.Height, Picture.Graphic);
      // must use TGraphicControl Canvas property
      TGCE(Self).Canvas.StretchDraw(Rect(0, 0, Width, Height), Fbmp);
    end;
  end
  else
    inherited Paint;
end;

procedure TTiledImage.SetTiled(const Value: Boolean);
begin
  if FTiled <> Value then
  begin
    FTiled := Value;
    Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents('3rdParty', [TTiledImage]);
end;

end.
Das habe ich naemlich mal bei Experts-Exchange gefragt.
TImage zu verstehen ist sehr schwer.
  Mit Zitat antworten Zitat