draw01.pas

特别方便的工具程序

unit Draw01;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Math, StdCtrls, ExtCtrls, JPEG, ComCtrls;

type
  TDrawForm = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Edit1: TEdit;
    Button9: TButton;
    Image2: TImage;
    Label1: TLabel;
    Edit2: TEdit;
    UpDown1: TUpDown;
    Sales: TCheckBox;
    Edit3: TEdit;
    UpDown2: TUpDown;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button9Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DrawForm: TDrawForm;
  M, N, S, K: integer;
  Cancel: Boolean = False;
implementation

{$R *.DFM}

{procedure TDrawForm.Button1Click(Sender: TObject);
Type
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array [Byte] of TRGBQuad;
  PDataArray = ^DataArray;
  DataArray = Array [1..Round(1E9)] of byte;
var
  DC: HDC;
  bW, bH: Word;
  PFile: TFileStream;
  Size: Integer;
  Temp: PDataArray;
  I: Integer;
  Head: PBITMAPINFO;
  PQ: PRGBQuad;
begin
  Image1.Width := 640;
  Image1.Height := 480;
  Image1.Show;
  PFile := TFileStream.Create('D:\AAAA.BMP', fmOpenRead);
  Size := PFile.Size;
  GetMem(Temp, Size);
  PFile.Read(Temp^, Size);
  PFile.Free;
  BW := UpDown1.Position;
  BH := 244;
  Label1.Caption := Format('W:=%d  H:=%d',[bw, bh]);
  Image1.Picture := nil;
  DC := Image1.Canvas.Handle;
  GetMem(Head, SizeOf(BITMAPINFO) + SizeOf(RGBQUAD) * 32);
  With Head.bmiHeader Do Begin
    biSize := SizeOf(BITMAPINFOHEADER);
    biPlanes := 1;
    biWidth  := bW;
    biHeight := bH;
    biBitCount := 8;
    biSizeImage := 0;
    biCompression := 0;
    biXPelsPerMeter := 0;
    biYPelsPerMeter := 0;
    biClrUsed      := 65;
    biClrImportant := 65;
  End;
  For i := 1 to Size Do Begin
//    Temp[i] := Temp[Size - i];
  End;

  For i := 0 to 31 Do Begin
    k := i shl 3 + 6;
    PQ := @PRGBQuadArray(@Head.bmiColors)[i];
    PQ.rgbRed := k;
    PQ.rgbGreen := k;
    PQ.rgbBlue := k;
    PQ.rgbReserved:= 0;
  End;
  With Head.bmiHeader Do
    SetDIBitsToDevice(DC, 0, 0, biWidth, biHeight,
       0, 0, 0, biHeight, Temp, Head^, DIB_RGB_COLORS);
  FreeMem(Head, SizeOf(BITMAPINFO) + SizeOf(RGBQUAD) * 32);
  FreeMem(Temp, Size);
end;
}

procedure TDrawForm.Button1Click(Sender: TObject);
type
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[Byte] of TRGBQuad;
  PDataArray = ^DataArray;
  DataArray = array[1..Round(1E9)] of byte;
var
  DC: HDC;
  bW, bH: Word;
  PFile: TFileStream;
  Size: Integer;
  Temp: PDataArray;
  I: Integer;
  Head: PBITMAPINFO;
  PQ: PRGBQuad;
begin
  Image1.Stretch := False;
  Image1.Width := 640;
  Image1.Height := 480;
  Image1.Show;
  PFile := TFileStream.Create('D:\Temp\B2.BMP', fmOpenRead);
  Size := PFile.Size;
  GetMem(Temp, Size);
  PFile.Seek(314, 0);
  PFile.Seek(118, 0);
  PFile.Read(Temp^, Size);
//  bw := 200; bH := 328;
  bw := 71; bH := 96;
  Label1.Caption := Format('W:=%d  H:=%d', [bw, bh]);
  Image1.Picture := nil;
  DC := Image1.Canvas.Handle;
  GetMem(Head, SizeOf(BITMAPINFO) + SizeOf(RGBQUAD) * 32);
  with Head.bmiHeader do begin
    biSize := SizeOf(BITMAPINFOHEADER);
    biPlanes := 1;
    biWidth := bW;
    biHeight := bH;
    biBitCount := 4;
    biSizeImage := 0;
    biCompression := 0;
    biXPelsPerMeter := 0;
    biYPelsPerMeter := 0;
    biClrUsed := 65;
    biClrImportant := 65;
  end;

  PFile.Seek($36, 0); { 读取色盘 36H }
//  PFile.Read(Temp^, Size);
  if Sales.Checked then
    for i := 0 to 15 do begin {15 = 16 色}
      PQ := @PRGBQuadArray(@Head.bmiColors)[i];
      PFile.Read(PQ.rgbBlue, 1);
      PFile.Read(PQ.rgbGreen, 1);
      PFile.Read(PQ.rgbRed, 1);
      PFile.Read(PQ.rgbReserved, 1);
      if PQ = nil then ;
    end else
    for i := 0 to 31 do begin //{ 灰度定义 }
      k := i shl 4 + 6;
      PQ := @PRGBQuadArray(@Head.bmiColors)[i];
      PQ.rgbRed := k;
      PQ.rgbGreen := k;
      PQ.rgbBlue := k;
      PQ.rgbReserved := 0;
    end;
  with Head.bmiHeader do
    SetDIBitsToDevice(DC, 0, 0, biWidth, biHeight,
      0, 0, 0, biHeight, Temp, Head^, DIB_RGB_COLORS);
  FreeMem(Head, SizeOf(BITMAPINFO) + SizeOf(RGBQUAD) * 32);
  FreeMem(Temp, Size);
  PFile.Free;
end;

procedure TDrawForm.FormCreate(Sender: TObject);
begin
  M := 20;
  K := 1;
end;

procedure TDrawForm.Button2Click(Sender: TObject);
var
  i: word;
  X1, Y1, X2, Y2, R1, R2: Word;
  X0, Y0, N: Word;
  A, DeltA: Real;
begin
  Image1.Width := 400;
  Image1.Height := 400;
  Image1.Canvas.Pen.Color := clWhite;
  Image1.Canvas.Brush.Color := clBlue;
  Image1.Canvas.Ellipse(0, 0, 400, 400);
  X0 := 200;
  Y0 := 200;
  R1 := 200;
  R2 := 010;
  N := 60;
  DeltA := PI - ArcSin(2 * R2 / R1);
  with Image1.Canvas do
    for i := 1 to N do begin
      A := I * 2 * PI / N;
      X1 := Trunc(R1 * (Cos(A)));
      Y1 := Trunc(R1 * (Sin(A)));
      MoveTo(X0 + X1, Y0 + Y1);
{    X2 := Trunc(R1 * (Cos(A - DeltA)));
    Y2 := Trunc(R1 * (Sin(A - DeltA)));
    LineTo(X0 + X2, Y0 + Y2);
 }
      MoveTo(X0 + X1, Y0 + Y1);
      X2 := Trunc(R1 * (Cos(DeltA + A)));
      Y2 := Trunc(R1 * (Sin(DeltA + A)));
      LineTo(X0 + X2, Y0 + Y2);
    end;
end;

procedure TDrawForm.Button3Click(Sender: TObject);
var
  R1: Word;
  X0, Y0: Word;
  A: Real;
  Dt: array[1..2, Byte] of Word;
  i: word;
begin
  Image1.Width := 400;
  Image1.Height := 400;
  Image1.Canvas.Pen.Color := clBlue;
  Image1.Canvas.Brush.Color := clBlue;
  Image1.Canvas.Rectangle(0, 0, 401, 401);
  Image1.Canvas.Brush.Color := clRed;
  Image1.Canvas.Ellipse(0, 0, 401, 401);
  Image1.Canvas.Pen.Color := clYellow;
  Image1.Canvas.Brush.Color := clSilver;
  X0 := 200; Y0 := 200;
  R1 := 200;
  N := 100;
  if M < 20 then begin
    K := 1;
  end;
  if M > N then begin
    K := -1;
  end;
  M := M + K;
  Edit1.Text := inttostr(M) + ':' + inttostr(K);
  for i := 1 to N do begin
    A := (i * 2 * PI + M) / N;
    Dt[1, i] := X0 + Trunc(R1 * (Cos(A)));
    Dt[2, i] := Y0 + Trunc(R1 * (Sin(A)));
  end;

  with Image1.Canvas do
    for i := 1 to N do begin
      MoveTo(Dt[1, i], Dt[2, i]);
      LineTo(Dt[1, (i + N * M div 100) mod N + 1], Dt[2, (i + N * M div 100) mod N + 1]);
    end;
end;

procedure TDrawForm.Timer1Timer(Sender: TObject);
begin
  Image1.Picture := nil;
  Cancel := False;
  Image1.Stretch := True;
  repeat
    Button3Click(Self);
    Application.Processmessages;
    Sleep(Updown2.Position);
  until Cancel;
end;

procedure TDrawForm.Button5Click(Sender: TObject);
var
  jp: TJpegImage;
begin
  jp := TJpegImage.Create;
  Jp.Assign(Image1.Picture.Bitmap);
  Jp.SaveToFile('D:\AAAA.JPG');
  jp.Free;
  Image1.Picture.SaveToFile('D:\AAAA.BMP');
end;

procedure TDrawForm.Button6Click(Sender: TObject);
begin
  Image1.Show;
  Image1.Picture.LoadFromFile('D:\AAAA.JPG');
end;

procedure TDrawForm.Button7Click(Sender: TObject);
begin
  Cancel := True;
end;

procedure TDrawForm.Button8Click(Sender: TObject);
begin
  Cancel := True;
  Close;
end;

procedure TDrawForm.Button3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image1.Picture := nil;
end;

procedure TDrawForm.Button9Click(Sender: TObject);
var
  i, j: word;
begin
  for i := 0 to 400 do
    for j := 0 to 400 do begin
      if Image1.Canvas.Pixels[i, j] = 0 then
    end;
end;

procedure TDrawForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Cancel := True;
end;

end.