1 unit MoyouU; 2 3 interface 4 5 uses 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 StdCtrls, ExtCtrls, ComCtrls; 8 9 type 10 TFormMain = class(TForm) 11 PanelMain: TPanel; 12 ButtonClose: TButton; 13 LabelZahyou: TLabel; 14 RadioGroupKiseki: TRadioGroup; 15 PanelBlue: TPanel; 16 TrackBarBlue: TTrackBar; 17 PanelGreen: TPanel; 18 PanelRed: TPanel; 19 TrackBarRed: TTrackBar; 20 TrackBarGreen: TTrackBar; 21 PanelIro: TPanel; 22 LabelIro: TLabel; 23 ImageMain: TImage; 24 ImageMoyou: TImage; 25 ButtonCopy: TButton; 26 ButtonRandom: TButton; 27 ButtonAuto: TButton; 28 TimerMoyou: TTimer; 29 ButtonSave: TButton; 30 procedure ButtonCloseClick(Sender: TObject); 31 procedure ImageMainMouseDown(Sender: TObject; Button: TMouseButton; 32 Shift: TShiftState; X, Y: Integer); 33 procedure ImageMainMouseUp(Sender: TObject; Button: TMouseButton; 34 Shift: TShiftState; X, Y: Integer); 35 procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, 36 Y: Integer); 37 procedure TrackBarRedChange(Sender: TObject); 38 procedure FormCreate(Sender: TObject); 39 procedure ButtonCopyClick(Sender: TObject); 40 procedure ButtonRandomClick(Sender: TObject); 41 procedure ButtonAutoClick(Sender: TObject); 42 procedure TimerMoyouTimer(Sender: TObject); 43 procedure ButtonSaveClick(Sender: TObject); 44 private 45 { Private 宣言 } 46 DownFlag : Boolean; // マウスボタンを押した状態かどうか 47 procedure CopyMainKaraMoyou; 48 procedure RandomByouga; 49 public 50 { Public 宣言 } 51 end; 52 53 var 54 FormMain: TFormMain; 55 56 implementation 57 58 {$R *.DFM} 59 (******************** 一般のプロシージャ ********************) 60 (******************** フォームのメソッド ********************) 61 procedure TFormMain.CopyMainKaraMoyou; 62 { メインイメージを模様イメージにコピーする } 63 var 64 X,Y : Integer; 65 begin 66 X := 0; 67 repeat 68 Y := 0; 69 repeat 70 ImageMoyou.Canvas.CopyRect(Rect(X,Y,X+100,Y+100),ImageMain.Canvas,Rect(0,0,100,100)); 71 ImageMoyou.Canvas.CopyRect(Rect(X+199,Y,X+99,Y+100),ImageMain.Canvas,Rect(0,0,100,100)); 72 ImageMoyou.Canvas.CopyRect(Rect(X,Y+199,X+100,Y+99),ImageMain.Canvas,Rect(0,0,100,100)); 73 ImageMoyou.Canvas.CopyRect(Rect(X+199,Y+199,X+99,Y+99),ImageMain.Canvas,Rect(0,0,100,100)); 74 Y := Y+200; 75 until Y > ImageMoyou.Height; 76 X := X+200; 77 until X > ImageMoyou.Width; 78 end; {CopyMainKaraMoyou} 79 80 procedure TFormMain.RandomByouga; 81 { メインイメージにランダムに描画してコピーする } 82 var 83 N : Integer; 84 X1,Y1,X2,Y2 : Integer; 85 Iro : TColor; 86 Futosa : Byte; 87 begin 88 for N := 1 to 100 do 89 begin 90 X1 := Random(100); 91 Y1 := Random(100); 92 X2 := Random(100); 93 Y2 := Random(100); 94 Iro := Random($1000000); 95 Futosa := Random(5)+1; 96 with ImageMain.Canvas do 97 begin 98 Pen.Color := Iro; 99 Pen.Width := Futosa; 100 MoveTo(X1,Y1); 101 LineTo(X2,Y2); 102 MoveTo(Y1,X1); 103 LineTo(Y2,X2); 104 end; 105 end; 106 CopyMainKaraMoyou; 107 end; {RandomByouga} 108 109 (******************** イベントハンドラー ********************) 110 111 procedure TFormMain.ButtonCloseClick(Sender: TObject); 112 begin 113 Close; 114 end; {ButtonCloseClick} 115 116 procedure TFormMain.ImageMainMouseDown(Sender: TObject; 117 Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 118 begin 119 ImageMain.Canvas.MoveTo(X,Y); // ペンを (X,Y) に移動する 120 DownFlag := True; // 描画開始 121 end; {ImageMouseDown} 122 123 procedure TFormMain.ImageMainMouseMove(Sender: TObject; Shift: TShiftState; 124 X, Y: Integer); 125 begin 126 if DownFlag // 描画中ならば 127 and (RadioGroupKiseki.ItemIndex = 0) // 軌跡を描く場合 128 then ImageMain.Canvas.LineTo(X,Y); // (X,Y) まで線を引く 129 LabelZahyou.Caption := Format('(%4d,%4d)',[X,Y]); 130 end; {ImageMainMouseMove} 131 132 procedure TFormMain.ImageMainMouseUp(Sender: TObject; Button: TMouseButton; 133 Shift: TShiftState; X, Y: Integer); 134 begin 135 ImageMain.Canvas.LineTo(X,Y); // (X,Y) まで線を引く 136 DownFlag := False; // 描画終了 137 end; {ImageMouseUp} 138 139 procedure TFormMain.TrackBarRedChange(Sender: TObject); 140 var 141 R,G,B : Byte; 142 Iro : TColor; 143 begin 144 R := TrackBarRed.Position; 145 G := TrackBarGreen.Position; 146 B := TrackBarBlue.Position; 147 Iro := R+G*$100+B*$10000; 148 LabelIro.Color := Iro; 149 PanelIro.Caption := Format(' 線の色=$%6x',[Iro]); 150 ImageMain.Canvas.Pen.Color := Iro; 151 end; {TrackBarRedChange} 152 153 procedure TFormMain.FormCreate(Sender: TObject); 154 begin 155 WindowState := wsMaximized; 156 ImageMain.Canvas.Pen.Color := clWhite; 157 ImageMain.Canvas.Rectangle(Rect(0,0,100,100)); 158 end; {FormCreate} 159 160 procedure TFormMain.ButtonCopyClick(Sender: TObject); 161 begin 162 CopyMainKaraMoyou; 163 end; {ButtonCopyClick} 164 165 procedure TFormMain.ButtonRandomClick(Sender: TObject); 166 begin 167 RandomByouga; 168 end; {ButtonRandomClick} 169 170 procedure TFormMain.ButtonAutoClick(Sender: TObject); 171 begin 172 TimerMoyou.Enabled := not TimerMoyou.Enabled; 173 end; {ButtonRandomClick} 174 175 procedure TFormMain.TimerMoyouTimer(Sender: TObject); 176 begin 177 RandomByouga; 178 end; {TimerMoyouTimer} 179 180 procedure TFormMain.ButtonSaveClick(Sender: TObject); 181 begin 182 ImageMoyou.Picture.SaveToFile('模様.bmp'); 183 end; {ButtonSaveClick} 184 185 end.