Changeset 313 for trunk/Packages/CevoComponents
- Timestamp:
- Mar 17, 2021, 11:11:55 AM (4 years ago)
- Location:
- trunk/Packages/CevoComponents
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/CevoComponents/DrawDlg.pas
r297 r313 202 202 if Components[cix] is TButtonBase then 203 203 begin 204 TButtonBase(Components[cix]).Graphic := GrExt[HGrSystem].Data;204 TButtonBase(Components[cix]).Graphic := HGrSystem.Data; 205 205 // if ButtonDownSound <> '*' then 206 206 // DownSound := GetSoundsDir + DirectorySeparator + ButtonDownSound + '.wav'; … … 210 210 TButtonA(Components[cix]).Font := UniFont[ftButton]; 211 211 if Components[cix] is TButtonB then 212 TButtonB(Components[cix]).Mask := GrExt[HGrSystem].Mask;212 TButtonB(Components[cix]).Mask := HGrSystem.Mask; 213 213 end; 214 214 end; -
trunk/Packages/CevoComponents/ScreenTools.pas
r312 r313 25 25 TLoadGraphicFileOptions = set of TLoadGraphicFileOption; 26 26 27 { TGrExtDescr } 28 29 TGrExtDescr = class 30 Name: string; 31 Data: TBitmap; 32 Mask: TBitmap; 33 pixUsed: array of Byte; 34 procedure ResetPixUsed; 35 constructor Create; 36 destructor Destroy; override; 37 end; 38 39 { TGrExtDescrs } 40 41 TGrExtDescrs = class(TFPGObjectList<TGrExtDescr>) 42 function SearchByName(Name: string): TGrExtDescr; 43 function AddNew(Name: string): TGrExtDescr; 44 end; 45 46 TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton); 27 47 28 48 {$IFDEF WINDOWS} … … 38 58 function HexStringToColor(S: string): integer; 39 59 function LoadGraphicFile(Bmp: TBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): boolean; 40 function LoadGraphicSet(const Name: string): integer;41 procedure Dump(dst: TBitmap; HGr ,xDst, yDst, Width, Height, xGr, yGr: integer);42 procedure Sprite(Canvas: TCanvas; HGr ,xDst, yDst, Width, Height, xGr, yGr: integer);60 function LoadGraphicSet(const Name: string): TGrExtDescr; 61 procedure Dump(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer); 62 procedure Sprite(Canvas: TCanvas; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer); 43 63 overload; 44 procedure Sprite(dst: TBitmap; HGr ,xDst, yDst, Width, Height, xGr, yGr: integer);64 procedure Sprite(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer); 45 65 overload; 46 66 procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer); … … 168 188 cliWater = 4; 169 189 170 type171 172 { TGrExtDescr }173 174 TGrExtDescr = class175 Name: string;176 Data: TBitmap;177 Mask: TBitmap;178 pixUsed: array of Byte;179 procedure ResetPixUsed;180 constructor Create;181 destructor Destroy; override;182 end;183 184 { TGrExtDescrs }185 186 TGrExtDescrs = class(TFPGObjectList<TGrExtDescr>)187 function SearchByName(Name: string): TGrExtDescr;188 function AddNew(Name: string): TGrExtDescr;189 end;190 191 TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);192 193 190 var 194 191 Phrases: TStringTable; 195 192 Phrases2: TStringTable; 196 193 GrExt: TGrExtDescrs; 197 HGrSystem: Integer;198 HGrSystem2: Integer;194 HGrSystem: TGrExtDescr; 195 HGrSystem2: TGrExtDescr; 199 196 ClickFrameColor: Integer; 200 197 MainTextureAge: Integer; … … 495 492 end; 496 493 497 function LoadGraphicSet(const Name: string): Integer; 498 var 499 I: Integer; 494 function LoadGraphicSet(const Name: string): TGrExtDescr; 495 var 500 496 x: Integer; 501 497 y: Integer; … … 505 501 DataPixel: TPixelPointer; 506 502 MaskPixel: TPixelPointer; 507 NewGrExt: TGrExtDescr; 508 begin 509 NewGrExt := GrExt.SearchByName(Name); 510 if not Assigned(NewGrExt) then begin 511 NewGrExt := GrExt.AddNew(Name); 503 begin 504 Result := GrExt.SearchByName(Name); 505 if not Assigned(Result) then begin 506 Result := GrExt.AddNew(Name); 512 507 FileName := GetGraphicsDir + DirectorySeparator + Name; 513 if not LoadGraphicFile( NewGrExt.Data, FileName) then begin514 Result := -1;508 if not LoadGraphicFile(Result.Data, FileName) then begin 509 Result := nil; 515 510 Exit; 516 511 end; 517 512 518 NewGrExt.ResetPixUsed;519 520 xmax := NewGrExt.Data.Width - 1; // allows 4-byte access even for last pixel513 Result.ResetPixUsed; 514 515 xmax := Result.Data.Width - 1; // allows 4-byte access even for last pixel 521 516 // Why there was that limit? 522 517 //if xmax > 970 then 523 518 // xmax := 970; 524 519 525 NewGrExt.Mask.SetSize(NewGrExt.Data.Width, NewGrExt.Data.Height);526 527 NewGrExt.Data.BeginUpdate;528 NewGrExt.Mask.BeginUpdate;529 DataPixel := PixelPointer( NewGrExt.Data);530 MaskPixel := PixelPointer( NewGrExt.Mask);531 for y := 0 to ScaleToNative( NewGrExt.Data.Height) - 1 do begin520 Result.Mask.SetSize(Result.Data.Width, Result.Data.Height); 521 522 Result.Data.BeginUpdate; 523 Result.Mask.BeginUpdate; 524 DataPixel := PixelPointer(Result.Data); 525 MaskPixel := PixelPointer(Result.Mask); 526 for y := 0 to ScaleToNative(Result.Data.Height) - 1 do begin 532 527 for x := 0 to ScaleToNative(xmax) - 1 do begin 533 528 OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF; … … 548 543 MaskPixel.NextLine; 549 544 end; 550 NewGrExt.Data.EndUpdate; 551 NewGrExt.Mask.EndUpdate; 552 end; 553 Result := GrExt.IndexOf(NewGrExt); 554 end; 555 556 procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 545 Result.Data.EndUpdate; 546 Result.Mask.EndUpdate; 547 end; 548 end; 549 550 procedure Dump(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer); 557 551 begin 558 552 BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, 559 GrExt[HGr].Data.Canvas, xGr, yGr);553 HGr.Data.Canvas, xGr, yGr); 560 554 end; 561 555 … … 820 814 end; 821 815 822 procedure Sprite(Canvas: TCanvas; HGr ,xDst, yDst, Width, Height, xGr, yGr: integer);816 procedure Sprite(Canvas: TCanvas; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer); 823 817 begin 824 818 BitBltCanvas(Canvas, xDst, yDst, Width, Height, 825 GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND);819 HGr.Mask.Canvas, xGr, yGr, SRCAND); 826 820 BitBltCanvas(Canvas, xDst, yDst, Width, Height, 827 GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT);828 end; 829 830 procedure Sprite(dst: TBitmap; HGr ,xDst, yDst, Width, Height, xGr, yGr: integer);821 HGr.Data.Canvas, xGr, yGr, SRCPAINT); 822 end; 823 824 procedure Sprite(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer); 831 825 begin 832 826 BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, 833 GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND);827 HGr.Mask.Canvas, xGr, yGr, SRCAND); 834 828 BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, 835 GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT);829 HGr.Data.Canvas, xGr, yGr, SRCPAINT); 836 830 end; 837 831 … … 1010 1004 for x := 0 to wOrna - 1 do 1011 1005 for y := 0 to hOrna - 1 do begin 1012 p := GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y];1006 p := HGrSystem2.Data.Canvas.Pixels[xOrna + x, yOrna + y]; 1013 1007 if p = $0000FF then 1014 GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := Light1008 HGrSystem2.Data.Canvas.Pixels[xOrna + x, yOrna + y] := Light 1015 1009 else if p = $FF0000 then 1016 GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := Shade;1010 HGrSystem2.Data.Canvas.Pixels[xOrna + x, yOrna + y] := Shade; 1017 1011 end; 1018 1012 InitOrnamentDone := True; … … 1025 1019 for x := 0 to 9 do 1026 1020 for y := 0 to 9 do 1027 if GrExt[HGrSystem].Mask.Canvas.Pixels[66 + x, 47 + y] = 0 then1021 if HGrSystem.Mask.Canvas.Pixels[66 + x, 47 + y] = 0 then 1028 1022 begin 1029 intensity := GrExt[HGrSystem].Data.Canvas.Pixels[66 +1023 intensity := HGrSystem.Data.Canvas.Pixels[66 + 1030 1024 x, 47 + y] and $FF; 1031 GrExt[HGrSystem].Data.Canvas.Pixels[77 + x, 47 + y] :=1025 HGrSystem.Data.Canvas.Pixels[77 + x, 47 + y] := 1032 1026 T.clMark and $FF * intensity div $FF + T.clMark shr 8 and 1033 1027 $FF * intensity div $FF shl 8 + T.clMark shr 16 and 1034 1028 $FF * intensity div $FF shl 16; 1035 1029 end; 1036 BitBltCanvas( GrExt[HGrSystem].Mask.Canvas, 77, 47, 10, 10,1037 GrExt[HGrSystem].Mask.Canvas, 66, 47);1030 BitBltCanvas(HGrSystem.Mask.Canvas, 77, 47, 10, 10, 1031 HGrSystem.Mask.Canvas, 66, 47); 1038 1032 end; 1039 1033 … … 1144 1138 procedure PaintIcon(x, y, Kind: Integer); 1145 1139 begin 1146 BitBltCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas,1140 BitBltCanvas(ca, x, y + 6, 10, 10, HGrSystem.Mask.Canvas, 1147 1141 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND); 1148 BitBltCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Data.Canvas,1142 BitBltCanvas(ca, x, y + 6, 10, 10, HGrSystem.Data.Canvas, 1149 1143 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT); 1150 1144 end; … … 1286 1280 (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44); 1287 1281 begin 1288 Gradient(ca, x, y, 0, 1, Width, 0, GrExt[HGrSystem].Data.Canvas.Pixels1282 Gradient(ca, x, y, 0, 1, Width, 0, HGrSystem.Data.Canvas.Pixels 1289 1283 [187, 137 + Kind], Brightness); 1290 1284 end; … … 1304 1298 begin 1305 1299 Gradient(ca, x, y, 1, 0, 0, Height, 1306 GrExt[HGrSystem].Data.Canvas.Pixels[187, 137 + Kind], Brightness);1300 HGrSystem.Data.Canvas.Pixels[187, 137 + Kind], Brightness); 1307 1301 end; 1308 1302 … … 1366 1360 begin 1367 1361 BitBltCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14, 1368 14, GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15,1362 14, HGrSystem.Mask.Canvas, 67 + Kind mod 8 * 15, 1369 1363 70 + Kind div 8 * 15, SRCAND); 1370 1364 Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2, … … 1375 1369 BitBltCanvas(dst.Canvas, xIcon + 4 + (val mod 10) * 1376 1370 (14 * ld div sd) + i * (14 * ld div sd), yIcon + 3, 14, 14, 1377 GrExt[HGrSystem].Mask.Canvas, 67 + 7 mod 8 * 15,1371 HGrSystem.Mask.Canvas, 67 + 7 mod 8 * 15, 1378 1372 70 + 7 div 8 * 15, SRCAND); 1379 1373 Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) * … … 1399 1393 begin 1400 1394 BitBltCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14, 1401 GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15,1395 HGrSystem.Mask.Canvas, 67 + Kind mod 8 * 15, 1402 1396 70 + Kind div 8 * 15, SRCAND); 1403 1397 Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2, … … 1408 1402 BitBltCanvas(dst.Canvas, xIcon + 4 + (val div 10) * 1409 1403 (14 * ld div sd) + i * (10 * ld div sd), yIcon + 7, 10, 10, 1410 GrExt[HGrSystem].Mask.Canvas, 66 + Kind mod 11 * 11,1404 HGrSystem.Mask.Canvas, 66 + Kind mod 11 * 11, 1411 1405 115 + Kind div 11 * 11, SRCAND); 1412 1406 Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) * … … 1444 1438 for i := 0 to pos div 8 - 1 do 1445 1439 BitBltCanvas(ca, x + i * 8, y, 8, 7, 1446 GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind);1440 HGrSystem.Data.Canvas, 104, 9 + 8 * Kind); 1447 1441 BitBltCanvas(ca, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7, 1448 GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind);1442 HGrSystem.Data.Canvas, 104, 9 + 8 * Kind); 1449 1443 if Growth > 0 then 1450 1444 begin 1451 1445 for i := 0 to Growth div 8 - 1 do 1452 1446 BitBltCanvas(ca, x + pos + i * 8, y, 8, 7, 1453 GrExt[HGrSystem].Data.Canvas, 112, 9 + 8 * Kind);1447 HGrSystem.Data.Canvas, 112, 9 + 8 * Kind); 1454 1448 BitBltCanvas(ca, x + pos + 8 * (Growth div 8), y, 1455 Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas,1449 Growth - 8 * (Growth div 8), 7, HGrSystem.Data.Canvas, 1456 1450 112, 9 + 8 * Kind); 1457 1451 end … … 1460 1454 for i := 0 to -Growth div 8 - 1 do 1461 1455 BitBltCanvas(ca, x + pos + i * 8, y, 8, 7, 1462 GrExt[HGrSystem].Data.Canvas, 104, 1);1456 HGrSystem.Data.Canvas, 104, 1); 1463 1457 BitBltCanvas(ca, x + pos + 8 * (-Growth div 8), y, -Growth - 1464 1458 8 * (-Growth div 8), 7, 1465 GrExt[HGrSystem].Data.Canvas, 104, 1);1459 HGrSystem.Data.Canvas, 104, 1); 1466 1460 end; 1467 1461 Brush.Color := $000000; … … 1712 1706 MainTexture.Image := TBitmap.Create; 1713 1707 MainTextureAge := -2; 1714 ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175];1708 ClickFrameColor := HGrSystem.Data.Canvas.Pixels[187, 175]; 1715 1709 InitOrnamentDone := False; 1716 1710 GenerateNames := True;
Note:
See TracChangeset
for help on using the changeset viewer.