Einzelnen Beitrag anzeigen

dGeek
(Gast)

n/a Beiträge
 
#6

AW: Windows 8-Kopier-Dialog nachbasteln?

  Alt 27. Aug 2016, 21:53
Sieht doch schonmal lustig aus (Screenshot)

Delphi-Quellcode:
var
 Form1: TForm1;
 iRandom, iCnt, iCnt2, iNegative, bmpWidth, iOldY: Integer;
 bmp: TBitmap;

const
 cPenColor = $0079C579;
 cTopColor = $00359E35;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 Timer1.Enabled := not Timer1.Enabled;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Randomize;
 iRandom := 50;
 iCnt := 1;
 iCnt2 := 0;
 iNegative := 0;

 bmp := TBitmap.Create;
 bmp.Canvas.Pen.Width := 1;
 bmp.Width := PaintBox1.Width;
 bmp.Height := PaintBox1.Height;
 bmpWidth := bmp.Width;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 bmp.Free;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
 xPos: Integer;
begin
 if iNegative < 0 then
  begin
   xPos := iNegative;
   bmp.Width := bmp.Width + (xPos * -1);
   bmpWidth := bmp.Width + (iNegative * -1);
  end
 else
  begin
   xPos := 0;
   bmpWidth := bmp.Width;
  end;

 BitBlt(PaintBox1.Canvas.Handle, xPos, 0, bmpWidth, bmp.Height, bmp.Canvas.Handle, 0, 0, SrcCopy);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
 tmpRand: Integer;
begin
 if iCnt > 0 then
  begin
   repeat
    tmpRand := RandomRange(iRandom - 10, iRandom + 10);

   until tmpRand > 20;
  end;

 iRandom := tmpRand;
 iNegative := PaintBox1.Width - iCnt;

 Caption := IntToStr(iRandom) + ' ' + IntToStr(iNegative) + ' ' + IntToStr(bmpWidth) + ' ' +
  IntToStr(iOldY);

 bmp.Canvas.Pen.Color := cPenColor;
 bmp.Canvas.MoveTo(iCnt, PaintBox1.Height);
 bmp.Canvas.LineTo(iCnt, iRandom);

 bmp.Canvas.Pen.Color := cTopColor;
 bmp.Canvas.MoveTo(iCnt, iRandom);
 bmp.Canvas.LineTo(iCnt, iRandom - 2);

 // bmp.Canvas.Pixels[iCnt, iOldY] := clRed;

 PaintBox1.Repaint;

 inc(iCnt);
 iOldY := iRandom;
end;
Miniaturansicht angehängter Grafiken
unbenannt.png  
  Mit Zitat antworten Zitat