Thema: Delphi DelphiX: Suche Quellcodes!

Einzelnen Beitrag anzeigen

mimi

Registriert seit: 1. Dez 2002
Ort: Oldenburg(Oldenburg)
2.008 Beiträge
 
FreePascal / Lazarus
 

Re: DelphiX: Suche Quellcodes!

  Alt 4. Sep 2004, 18:05
hier mal meine lings zu delphiX:

Zitat:

hier eine fertige klasse zu delphiX mit der man sehr einfach delphiX benutzen kann ohne es zu können:
zusammenfalten · markieren
Delphi-Quellcode:
{
  Die DelphiX unit für das Game BreakOut

  Datum  = 25.07.2004
  Updatet = 02.09.2004
}

unit DX;

interface

uses dialogs,g,Graphics,DXDraws, DXClass,jpeg,Forms,SysUtils,Classes,Types,Controls;

type
  
  TDX = class(TGrafik)
    DXDraw1: TDXDraw;
    DXTimer1: TDXTimer;
    DXImageList1: TDXImageList;
 public
    procedure DrawText(Text:String; x,y,Size:Integer; Color,color1:TColor); override;
    procedure DrawImage(ImageIndex, ImageP, x,y:Integer);overload;override;
    procedure DrawImage(ImageStr:String; ImageP, x,y:Integer);overload;override;
    procedure DrawRoateImage(Name:String; x,y,a,pi:Integer; cx,cy:Double);override;

    procedure Init(F1:TForm;FileName:TFileName); override;
    function GetMausPos:TPoint;override;
    function kollision(nr1,nr2,nr1x,nr1y,nr2x,nr2y, pat1,pat2:integer):boolean;override;
   private
    mx,my:Integer;
    ImageDir:String;
    procedure DXDXDrawInitialize(Sender: TObject);
    procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
    procedure DXDraw1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    procedure DXDraw1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

    procedure LoadImageToListe(FileName:TFileName);

  end;

implementation

uses tools;

{
  Checkt ob eine collisions zwischen zwei objekten stadt findet

  Datum  = 25.07.2004
  Updatet = 25.07.2004
}

function TDX.kollision(nr1,nr2,nr1x,nr1y,nr2x,nr2y, pat1,pat2:integer):boolean;
var
  ueberlapp_breite, ueberlapp_hoehe:integer;
  ueberlapp_nr1_x, ueberlapp_nr1_y, ueberlapp_nr2_x,ueberlapp_nr2_y:integer;
  x,y:integer;
  nr1_breite, nr2_breite, nr1_hoehe, nr2_hoehe:integer;
  farbenr1,farbenr2:tcolor;
begin
  farbenr1:=clBlack;
  farbenr2:=clBlack;
  ueberlapp_nr1_x:=-1;
  ueberlapp_nr1_Y:=-1;

  ueberlapp_nr2_x:=-1;
  ueberlapp_nr2_Y:=-1;

  if (DXImageList1.Items[nr1].PatternWidth = 0 ) then
    begin
      nr1_breite := DXImageList1.Items[nr1].Width;
      nr1_hoehe := DXImageList1.Items[nr1].Height;
    end
  else
    begin
      nr1_breite := DXImageList1.Items[nr1].PatternWidth;
      nr1_hoehe := DXImageList1.Items[nr1].PatternHeight;
    end;
  if (DXImageList1.Items[nr2].PatternWidth = 0 ) then
    begin
      nr2_breite := DXImageList1.Items[nr2].Width;
      nr2_hoehe := DXImageList1.Items[nr2].Height;
    end
  else
    begin
      nr2_breite := DXImageList1.Items[nr2].PatternWidth;
      nr2_hoehe := DXImageList1.Items[nr2].PatternHeight;
    end;

  kollision := false;
  if nr1x < nr2x then
    ueberlapp_breite := (nr1x + nr1_breite) - (nr2x)
  else
    ueberlapp_breite := (nr2x + nr2_breite) - nr1x;
  if nr1_breite > nr2_breite then
    if ueberlapp_breite >= nr2_breite then ueberlapp_breite := nr2_breite;


 if nr1y < nr2y then
    ueberlapp_hoehe := (nr1y + nr1_hoehe) - (nr2y)
  else
    ueberlapp_hoehe := (nr2y + nr2_hoehe) - (nr1y);
  if nr1_hoehe > nr2_hoehe then
    if ueberlapp_hoehe > nr2_hoehe then ueberlapp_hoehe := nr2_hoehe;


  if (ueberlapp_breite > 0) and (ueberlapp_hoehe > 0) then
    begin
      if nr1_breite >= nr2_breite then
        begin
          if (nr2x+nr2_breite) >= (nr1x+nr1_breite) then
            begin
              ueberlapp_nr1_x := nr1_breite - ueberlapp_breite;
              ueberlapp_nr2_x := 0;
            end;
          if ((nr2x+nr2_breite) < (nr1x+nr1_breite))
               and (nr2x >= nr1x)then
            begin
              ueberlapp_nr1_x := (nr2x-nr1x);
              ueberlapp_nr2_x := 0;
            end;
          if (nr2x) < (nr1x) then
            begin
              ueberlapp_nr1_x := 0;
              ueberlapp_nr2_x := nr2_breite - ueberlapp_breite;
            end;
        end;
      if nr1_breite < nr2_breite then
        begin
          if (nr1x+nr1_breite) >= (nr2x+nr2_breite) then
            begin
              ueberlapp_nr2_x := nr2_breite - ueberlapp_breite;
              ueberlapp_nr1_x := 0;
            end;
          if ((nr1x+nr1_breite) < (nr2x+nr2_breite))
               and (nr1x >= nr2x)then
            begin
              ueberlapp_nr2_x := (nr1x-nr2x);
              ueberlapp_nr1_x := 0;
            end;
          if (nr1x < nr2x)then
            begin
              ueberlapp_nr2_x := 0;
              ueberlapp_nr1_x := nr1_breite - ueberlapp_breite;
            end;
        end;

      if nr1_hoehe >= nr2_hoehe then
        begin
          if (nr2y+nr2_hoehe) >= (nr1y+nr1_hoehe) then
            begin
              ueberlapp_nr1_y := nr1_hoehe - ueberlapp_hoehe;
              ueberlapp_nr2_y := 0;
            end;
          if ((nr2y+nr2_hoehe) < (nr1y+nr1_hoehe))
               and (nr2y >= nr1y)then
            begin
              ueberlapp_nr1_y := (nr2y-nr1y);
              ueberlapp_nr2_y := 0;
            end;
          if (nr2y) < (nr1y) then
            begin
              ueberlapp_nr1_y := 0;
              ueberlapp_nr2_y := nr2_hoehe - ueberlapp_hoehe;
            end;
        end;
      if nr1_hoehe < nr2_hoehe then
        begin
          if (nr1y+nr1_hoehe) >= (nr2y+nr2_hoehe) then
            begin
              ueberlapp_nr2_y := nr2_hoehe - ueberlapp_hoehe;
              ueberlapp_nr1_y := 0;
            end;
          if ((nr1y+nr1_hoehe) < (nr2y+nr2_hoehe))
               and (nr1y >= nr2y)then
            begin
              ueberlapp_nr2_y := (nr1y-nr2y);
              ueberlapp_nr1_y := 0;
            end;
          if (nr1y < nr2y)then
            begin
              ueberlapp_nr2_y := 0;
              ueberlapp_nr1_y := nr1_hoehe - ueberlapp_hoehe;
            end;
        end;



      for x := 0 to (ueberlapp_breite-1) div 4 do
        for y := 0 to (ueberlapp_hoehe -1)div 4 do begin
            if (pat1 = 0) and (DXImageList1.Items[nr1].PatternWidth = 0 ) then begin
               farbenr1:=DXImageList1.Items[nr1].picture.Bitmap.Canvas.Pixels[ueberlapp_nr1_x+x*4,ueberlapp_nr1_y+y*2];
            end;
            if (pat2 = 0) and (DXImageList1.Items[nr2].PatternWidth = 0 )then begin
               farbenr2:=DXImageList1.Items[nr2].picture.Bitmap.Canvas.Pixels[ueberlapp_nr2_x+x*4,ueberlapp_nr2_y+y*2];
            end;
            if (pat1 >= 0) and (DXImageList1.Items[nr1].PatternWidth > 0 ) then begin
               farbenr1:=DXImageList1.Items[nr1].PatternSurfaces[pat1].Canvas.Pixels[ueberlapp_nr1_x+x*4,ueberlapp_nr1_y+y*2];
            end;

            if (pat2 >= 0) and (DXImageList1.Items[nr2].PatternWidth > 0 ) then begin
               farbenr2:=DXImageList1.Items[nr2].PatternSurfaces[pat2].Canvas.Pixels[ueberlapp_nr2_x+x*4,ueberlapp_nr2_y+y*2];
            end;

            if ( farbenr1 <> DXImageList1.Items[nr1].TransparentColor) and (farbenr2 <> DXImageList1.Items[nr2].TransparentColor) then
              kollision := true;
          end;
         DXImageList1.Items[nr1].Restore;
         DXImageList1.Items[nr2].Restore;
    end;
end;


{
  Gibt die Maus Pos zurück

  Datum  = 25.07.2004
  Updatet = 25.07.2004
}

function TDX.GetMausPos:TPoint;
begin
  result.x:=mx;
  result.y:=my;
end;

{
  Zeichnet gedrehte Bilder auf der DXDraw Komponente

  Datum  = 02.09.2004
  Updatet = 02.09.2004
}

procedure TDX.DrawRoateImage(Name:String; x,y,a,pi:Integer; cx,cy:Double);
var
  i:Integer;
begin
  i:=DXImageList1.Items.Find(Name).Index;
  DXImageList1.Items[i].DrawRotate(DXDraw1.Surface,x,y,DXImageList1.Items[i].Width,DXImageList1.Items[i].Height,pi,cx,cy,a);
end;

{
  Zeichnet Bilder auf die DXDraw Komponente

  Datum  = 25.07.2004
  Updatet = 25.07.2004
}

procedure TDX.DrawImage(ImageStr:String; ImageP, x,y:Integer);
begin
  DXImageList1.Items[DXImageList1.Items.Find(imageStr).Index].Draw(DXDraw1.Surface,x,y,imageP);

end;

{
  Zeichnet Bilder auf die DXDraw Komponente

  Datum  = 25.07.2004
  Updatet = 25.07.2004
}

procedure TDX.DrawImage(ImageIndex, ImageP, x,y:Integer);
begin
  DXImageList1.Items[ImageIndex].Draw(DXDraw1.Surface,x,y,imageP);
end;

{
  Lädt alle Grafiken, in die DXImageList

  Datum  = 25.07.2004
  Updatet = 25.07.2004
}

procedure TDX.LoadImageToListe(FileName:TFileName);
var
  i:integer;
  bilder:TStringList;
  str:String;
begin
  bilder:=TStringList.create;
  bilder.LoadFromFile(FileName);

  for i:=0 to bilder.count-1 do begin
    DXImageList1.Items.Add;
    with DXImageList1.Items[i] do begin
      Picture.LoadFromFile(ImageDir + GetToken(Bilder.Strings[i],';',1));
      str:=GetToken(bilder.strings[i],';',2);

      PatternHeight:=StrToInt(GetToken( str,',',1));;
      PatternWidth:=StrToInt(GetToken( str,',',2));;

      Name:=GetToken(bilder.Strings[i],';',3);
      Transparent:=True; TransparentColor:=StringToColor(GetToken(bilder.Strings[i],';',4) );

    end;
  end;
end;

procedure TDX.DXDraw1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in shift then
    isLeftClick:=True
  else
    isLeftClick:=False;
end;

procedure TDX.DXDraw1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  mx:=x;
  my:=y;
end;

procedure TDX.DXTimerTimer(Sender: TObject; LagCount: Integer);
begin
  DXDraw1.Surface.Fill(0);

  onDraw;

  DXDraw1.Flip;
end;

procedure TDX.DXDXDrawInitialize(Sender: TObject);
begin
  DXTimer1.Enabled:=True;
end;

{
  Erstellt alle komponenten, die benötig werden, und lädt die Grafiken

  Datum  = 25.07.2004
  Updatet = 25.07.2004
}

procedure TDX.Init(F1:TForm;FileName:TFileName);
begin
  ImageDir:=ExtractFilePath(FileName);

  DXDraw1:=TDXDraw.Create(F1); DXDraw1.AutoInitialize:=False;
  DXDraw1.Height:=480; DXDraw1.Width:=640; DXDraw1.Left:=0; DXDraw1.Top:=0;
  DXDraw1.Parent:=F1;

  DXDraw1.OnInitialize:=DXDXDrawInitialize;
  DXDraw1.OnMouseMove:=DXDraw1MouseMove;
  DXDraw1.OnMouseDown:=DXDraw1MouseDown;

  DXDraw1.Cursor:=-1;

  DXImageList1:=TDXImageList.Create(F1);
  DXImageList1.DXDraw:=DXDraw1;
  LoadImageToListe(FileName);

  DXTimer1:=TDXTimer.Create(F1);
  DXTimer1.OnTimer:=DXTimerTimer; DXTimer1.Interval:=0; DXTimer1.Enabled:=False;
  DXDraw1.Initialize;
end;

{
  Zeichnet einen Text auf den Bildschirm

  Datum  = 25.07.2004
  Updatet = 25.07.2004
}


procedure TDX.DrawText(Text:String; x,y,Size:Integer; Color,color1:TColor);
begin
  with DXDraw1.Surface.Canvas do begin
    Brush.Style := bsClear;
    Font.Style := [fsBold];
    Font.Name := 'Verdana';
    Font.Size := Size;
    Font.Color := color1;
    TextOut(x, y, Text);
    Font.Color := clGray;

    TextOut(x - 1, y - 1, Text);
    Font.Color := clSilver;
    TextOut(x - 4, y - 2, Text);
    Font.Color := color;

    TextOut(x - 3, y - 5, Text);
    Release;
  end;
end;


end.
Michael Springwald
MFG
Michael Springwald,
Bitte nur Deutsche Links angeben Danke (benutzte überwiegend Lazarus)
  Mit Zitat antworten Zitat