1 unit umain; 2 3 {$mode objfpc}{$H+} 4 5 interface 6 7 uses 8 Classes, Forms, Graphics, SysUtils, BCGameGrid, BGRABitmap, 9 BGRABitmapTypes, types, Controls, Dialogs, ExtCtrls, LCLType, BCEffect; 10 11 type 12 13 { TForm1 } 14 15 TForm1 = class(TForm) 16 BCGameGrid2: TBCGameGrid; 17 Timer1: TTimer; 18 procedure BCGameGrid2ClickControl(Sender: TObject; n, x, y: integer); 19 procedure BCGameGrid2MouseDown(Sender: TObject; Button: TMouseButton; 20 Shift: TShiftState; X, Y: integer); 21 procedure BCGameGrid2MouseEnter(Sender: TObject); 22 procedure BCGameGrid2MouseLeave(Sender: TObject); 23 procedure BCGameGrid2MouseMove(Sender: TObject; Shift: TShiftState; 24 X, Y: integer); 25 procedure BCGameGrid2MouseUp(Sender: TObject; Button: TMouseButton; 26 Shift: TShiftState; X, Y: integer); 27 procedure BCGameGrid2MouseWheel(Sender: TObject; Shift: TShiftState; 28 WheelDelta: integer; MousePos: TPoint; var Handled: boolean); 29 procedure BCGameGrid2MouseWheelDown(Sender: TObject; Shift: TShiftState; 30 MousePos: TPoint; var Handled: boolean); 31 procedure BCGameGrid2MouseWheelUp(Sender: TObject; Shift: TShiftState; 32 MousePos: TPoint; var Handled: boolean); 33 procedure BCGameGrid2RenderControl(Sender: TObject; Bitmap: TBGRABitmap; 34 r: TRect; n, x, y: integer); 35 procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); 36 procedure FormCreate(Sender: TObject); 37 procedure FormHide(Sender: TObject); 38 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 39 procedure Timer1Timer(Sender: TObject); 40 private 41 procedure SetFSelected(AValue: integer); 42 { private declarations } 43 public 44 { public declarations } 45 FSelected: integer; 46 Fade: TFading; 47 property Selected: integer read FSelected write SetFSelected; 48 end; 49 50 var 51 Form1: TForm1; 52 53 const 54 L1 = VK_LEFT; 55 R1 = VK_RIGHT; 56 U1 = VK_UP; 57 D1 = VK_DOWN; 58 L2 = VK_A; 59 R2 = VK_D; 60 U2 = VK_W; 61 D2 = VK_S; 62 63 implementation 64 65 {$R *.lfm} 66 67 { TForm1 } 68 69 procedure TForm1.BCGameGrid2RenderControl(Sender: TObject; Bitmap: TBGRABitmap; 70 r: TRect; n, x, y: integer); 71 var 72 cr, cg, cb, ca: byte; 73 bmp: TBGRABitmap; 74 begin 75 cr := Random(100); 76 cg := Random(100); 77 cb := Random(255); 78 ca := Random(100); 79 80 // selected 81 82 if Selected = n then 83 begin 84 ca := 255; 85 Bitmap.FillRect(r, BGRA(0, 0, 255, Fade.Execute), dmSet); 86 end 87 88 // colors 89 90 else 91 begin 92 Bitmap.FillRect(r, BGRA(cr, cg, cb, ca), dmSet); 93 Bitmap.Rectangle(r, BGRA(100, 100, 100, ca), dmDrawWithTransparency); 94 end; 95 96 // text 97 98 Bitmap.TextRect(r, concat('n', IntToStr(n), ',x', IntToStr(x), ',y', IntToStr(y)), 99 taCenter, tlCenter, BGRA(0, 0, 0, ca)); 100 101 // crazy effect 102 103 if n = BCGameGrid2.GridWidth * BCGameGrid2.GridHeight -1 then { remove this if you want to see the original thing... } 104 if Odd(n) then { this is for improve speed... } 105 begin 106 bmp := Bitmap.FilterBlurRadial(1, rbFast) as TBGRABitmap; 107 Bitmap.BlendImage(Random(4), Random(4), bmp, boLinearBlend); 108 bmp.Free; 109 end; 110 111 end; 112 113 procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean); 114 begin 115 Timer1.Enabled := False; 116 end; 117 118 procedure TForm1.FormCreate(Sender: TObject); 119 begin 120 Fade.Mode := fmFadeInOut; 121 Fade.Step := 17; 122 Fade.Reset; 123 end; 124 125 procedure TForm1.FormHide(Sender: TObject); 126 begin 127 128 end; 129 130 procedure TForm1.FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 131 132 begin 133 if (Key = L1) or (Key = L2) then 134 Selected := Selected - 1 135 else if (Key = R1) or (Key = R2) then 136 Selected := Selected + 1 137 else if (Key = U1) or (Key = U2) then 138 Selected := Selected - BCGameGrid2.GridWidth 139 else if (Key = D1) or (Key = D2) then 140 Selected := Selected + BCGameGrid2.GridWidth; 141 end; 142 143 procedure TForm1.Timer1Timer(Sender: TObject); 144 begin 145 BCGameGrid2.RenderAndDrawControl; 146 end; 147 148 procedure TForm1.SetFSelected(AValue: integer); 149 begin 150 if FSelected = AValue then 151 Exit; 152 FSelected := AValue; 153 end; 154 155 procedure TForm1.BCGameGrid2ClickControl(Sender: TObject; n, x, y: integer); 156 begin 157 Selected := n; 158 end; 159 160 procedure TForm1.BCGameGrid2MouseDown(Sender: TObject; Button: TMouseButton; 161 Shift: TShiftState; X, Y: integer); 162 begin 163 {if Button = mbLeft then 164 ...} 165 end; 166 167 procedure TForm1.BCGameGrid2MouseEnter(Sender: TObject); 168 begin 169 //ShowMessage('Enter'); 170 end; 171 172 procedure TForm1.BCGameGrid2MouseLeave(Sender: TObject); 173 begin 174 //ShowMessage('Leave'); 175 end; 176 177 procedure TForm1.BCGameGrid2MouseMove(Sender: TObject; Shift: TShiftState; 178 X, Y: integer); 179 begin 180 {if ssLeft in Shift then 181 ...} 182 end; 183 184 procedure TForm1.BCGameGrid2MouseUp(Sender: TObject; Button: TMouseButton; 185 Shift: TShiftState; X, Y: integer); 186 begin 187 {if ssLeft in Shift then 188 ...} 189 end; 190 191 procedure TForm1.BCGameGrid2MouseWheel(Sender: TObject; Shift: TShiftState; 192 WheelDelta: integer; MousePos: TPoint; var Handled: boolean); 193 begin 194 //ShowMessage('Wheeeeel!'); 195 end; 196 197 procedure TForm1.BCGameGrid2MouseWheelDown(Sender: TObject; Shift: TShiftState; 198 MousePos: TPoint; var Handled: boolean); 199 begin 200 { Decrease grid } 201 BCGameGrid2.GridWidth := BCGameGrid2.GridWidth - 1; 202 BCGameGrid2.GridHeight := BCGameGrid2.GridHeight - 1; 203 end; 204 205 procedure TForm1.BCGameGrid2MouseWheelUp(Sender: TObject; Shift: TShiftState; 206 MousePos: TPoint; var Handled: boolean); 207 begin 208 { Increase grid } 209 BCGameGrid2.GridWidth := BCGameGrid2.GridWidth + 1; 210 BCGameGrid2.GridHeight := BCGameGrid2.GridHeight + 1; 211 end; 212 213 end. 214