(Gast)
n/a Beiträge
|
AW: Windows 8-Kopier-Dialog nachbasteln?
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;
|
|
Zitat
|