Programowanie w języku Delphi » Gotowce

Rysowanie

  • 2005-12-29 22:26
  • 3 komentarze
  • 1899 odsłon
  • Oceń ten tekst jako pierwszy
Na formie muszą znajdować się 3 komponenty image i jeden timer.
Ustaw właściwość Timer.Enabled na False, a Interval na 10,
Image2.Visible i Image3.Visible na False;

Komponent image, na którym rysujemy nie może być pusty.
Całość wygląda tak:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Timer1: TTimer;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  X1,Y1,X2,Y2:Integer;
  RysujImage : Boolean;
 
implementation
 
{$R *.DFM}
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
X1:=X;
Y1:=Y;
RysujImage:=True;
Image2.Picture:=Image1.Picture;
Image3.Picture:=Image1.Picture;
Timer1.Enabled:=True;
end;
 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
x2:=x;
y2:=y;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  x3,y3 : integer;
  P,PP : PByteArray;
begin
if RysujImage=True then // jeżeli przycisk jest wciśnięty (RysujImage=True).
begin
// tu musimy wczytać do image3 (tego, na którym rysujemy) rysunek z image2 (obraz przed rozpoczęciem rysowania).
Image3.Picture:=Image2.Picture;
// Ustawiamy kolor linii
Image3.Canvas.Pen.Color:=255;
// Styl wypełnienia
Image3.Canvas.Brush.Style:=bsClear;
// Rysowanie Okręgu
Image3.Canvas.Ellipse(x1,y1,x2,y2);
 
Image1.Picture.BitMap.PixelFormat:=pf24Bit;
Image3.Picture.BitMap.PixelFormat:=pf24Bit;
    for y3:=1 to Image1.Height-1 do
      begin
        // zeskanowanie poziomej linii piksli bitmapy z image1
        P:=Image1.Picture.Bitmap.ScanLine[y3];
        // zeskanowanie poziomej linii piksli bitmapy z image3
        PP:=Image3.Picture.Bitmap.ScanLine[y3];
        x3:=0;
        repeat
          P[x3]:=PP[x3];
          P[x3+1]:=PP[x3+1];
          P[x3+2]:=PP[x3+2];
          x3:=x3+3;
        until x3>(Image1.Width-1)*3;
        // tutaj mnoży się przez 3 dla 24 bitów, a przez 4 dla 32 bitów
      end;
  Image1.Invalidate;
end;
end;
 
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
RysujImage:=False;
Timer1.Enabled:=False;
end;
 
end.

3 komentarze

Kopek 2008-05-14 22:16

Nie tylko nie może być pusty. Rozmiar Image1 musi byc takiej samej lub mniejszej wielkości niż sama bitmapa.
Można łatwo obejść, zamiast Image1.Height uzyc Image1.Picture.Bitmap.Height. Analogicznie, Image1.Picture.Bitmap.Canvas itd.
Pozdrawiam

jarekow2 2003-02-23 20:38

Przepraszam, nie napisałem, że komponent nie może być pusty (musi być tam jakaś bitmapa).

Już to poprawiłem.

AMS 2003-02-18 20:45

to nie działa to "malowanie" bo wyskakuje błąd jak kce siem cos namalować "Scan Line index of range."