Changeset 463 for branches/highdpi/Packages/CevoComponents/ScreenTools.pas
- Timestamp:
- Nov 29, 2023, 2:35:44 PM (12 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/Packages/CevoComponents/ScreenTools.pas
r405 r463 8 8 {$ENDIF} 9 9 StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math, 10 Forms, Menus, GraphType, fgl, UGraphicSet, LazFileUtils, UTexture;10 Forms, Menus, GraphType, GraphicSet, LazFileUtils, Texture; 11 11 12 12 type … … 17 17 18 18 {$IFDEF WINDOWS} 19 function ChangeResolution( x, y, bpp, freq: integer): boolean;19 function ChangeResolution(X, Y, bpp, freq: Integer): Boolean; 20 20 {$ENDIF} 21 21 procedure RestoreResolution; 22 22 procedure EmptyMenu(MenuItems: TDpiMenuItem; Keep: Integer = 0); 23 function TurnToYear(Turn: integer): integer;24 function TurnToString(Turn: integer): string;25 function MovementToString(Movement: integer): string;26 procedure BtnFrame( ca: TDpiCanvas; p: TRect; T: TTexture);27 procedure EditFrame( ca: TDpiCanvas; p: TRect; T: TTexture);28 function HexStringToColor(S: string): integer;23 function TurnToYear(Turn: Integer): Integer; 24 function TurnToString(Turn: Integer): string; 25 function MovementToString(Movement: Integer): string; 26 procedure BtnFrame(Canvas: TDpiCanvas; P: TRect; T: TTexture); 27 procedure EditFrame(Canvas: TDpiCanvas; P: TRect; T: TTexture); 28 function HexStringToColor(S: string): Integer; 29 29 function ExtractFileNameWithoutExt(const Filename: string): string; 30 function LoadGraphicFile(Bmp: TDpiBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): boolean; 31 function LoadGraphicSet(const Name: string): TGraphicSet; 32 function LoadGraphicSet2(const Name: string): TGraphicSet; 33 procedure Dump(dst: TDpiBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 30 function LoadGraphicFile(Bmp: TDpiBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): Boolean; 31 function LoadGraphicSet(const Name: string; Transparency: Boolean = True): TGraphicSet; 32 procedure Dump(dst: TDpiBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 34 33 procedure BitmapReplaceColor(Dst: TDpiBitmap; X, Y, Width, Height: Integer; OldColor, NewColor: TColor); 35 procedure Sprite(Canvas: TDpiCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);34 procedure Sprite(Canvas: TDpiCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 36 35 overload; 37 procedure Sprite(dst: TDpiBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);36 procedure Sprite(dst: TDpiBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 38 37 overload; 39 38 procedure MakeBlue(Dst: TDpiBitmap; X, Y, Width, Height: Integer); … … 46 45 procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height, 47 46 Color0, Color2: Integer); 48 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer);49 function DpiBit Canvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer;47 procedure ImageOp_CCC(bmp: TDpiBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer); 48 function DpiBitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer; 50 49 SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload; 51 function DpiBit Canvas(Dest: TDpiCanvas; DestRect: TRect;50 function DpiBitBltCanvas(Dest: TDpiCanvas; DestRect: TRect; 52 51 Src: TDpiCanvas; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload; 53 52 function BitBltBitmap(Dest: TDpiBitmap; X, Y, Width, Height: Integer; … … 55 54 function BitBltBitmap(Dest: TDpiBitmap; DestRect: TRect; 56 55 Src: TDpiBitmap; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload; 57 procedure SLine( ca: TDpiCanvas; x0, x1, y: integer; cl: TColor);58 procedure DLine( ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor);59 procedure Frame( ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);60 procedure RFrame( ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);61 procedure CFrame( ca: TDpiCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);62 procedure FrameImage( ca: TDpiCanvas; Src: TDpiBitmap;63 x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);64 procedure GlowFrame(Dst: TDpiBitmap; x0, y0, Width, Height: integer; cl: TColor);56 procedure SLine(Canvas: TDpiCanvas; x0, x1, Y: Integer; cl: TColor); 57 procedure DLine(Canvas: TDpiCanvas; x0, x1, Y: Integer; cl0, cl1: TColor); 58 procedure Frame(Canvas: TDpiCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor); 59 procedure RFrame(Canvas: TDpiCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor); 60 procedure CFrame(Canvas: TDpiCanvas; x0, y0, x1, y1, Corner: Integer; cl: TColor); 61 procedure FrameImage(Canvas: TDpiCanvas; Src: TDpiBitmap; 62 X, Y, Width, Height, xSrc, ySrc: Integer; IsControl: Boolean = False); 63 procedure GlowFrame(Dst: TDpiBitmap; x0, y0, Width, Height: Integer; cl: TColor); 65 64 procedure InitOrnament; 66 procedure InitCityMark(T : TTexture);67 procedure Fill( ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer); overload;65 procedure InitCityMark(Texture: TTexture); 66 procedure Fill(Canvas: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer); overload; 68 67 procedure Fill(Canvas: TDpiCanvas; Rect: TRect; Offset: TPoint); overload; 69 procedure FillLarge( ca: TDpiCanvas; x0, y0, x1, y1, xm: integer);70 procedure FillSeamless( ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;68 procedure FillLarge(Canvas: TDpiCanvas; x0, y0, x1, y1, xm: Integer); 69 procedure FillSeamless(Canvas: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer; 71 70 const Texture: TDpiBitmap); 72 procedure FillRectSeamless( ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;71 procedure FillRectSeamless(Canvas: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer; 73 72 const Texture: TDpiBitmap); 74 procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: integer);75 procedure Corner( ca: TDpiCanvas; x, y, Kind: integer; T: TTexture);76 procedure BiColorTextOut( ca: TDpiCanvas; clMain, clBack: TColor; x, y: integer; s: string);77 procedure LoweredTextOut( ca: TDpiCanvas; cl: TColor; T: TTexture;78 x, y: integer; s: string);79 function BiColorTextWidth( ca: TDpiCanvas; s: string): integer;80 procedure RisedTextOut( ca: TDpiCanvas; x, y: integer; s: string);81 procedure LightGradient( ca: TDpiCanvas; x, y, Width, Color: integer);82 procedure DarkGradient( ca: TDpiCanvas; x, y, Width, Kind: integer);83 procedure VLightGradient( ca: TDpiCanvas; x, y, Height, Color: integer);84 procedure VDarkGradient( ca: TDpiCanvas; x, y, Height, Kind: integer);73 procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: Integer); 74 procedure Corner(Canvas: TDpiCanvas; X, Y, Kind: Integer; T: TTexture); 75 procedure BiColorTextOut(Canvas: TDpiCanvas; clMain, clBack: TColor; X, Y: Integer; S: string); 76 procedure LoweredTextOut(Canvas: TDpiCanvas; cl: TColor; T: TTexture; 77 X, Y: Integer; S: string); 78 function BiColorTextWidth(Canvas: TDpiCanvas; S: string): Integer; 79 procedure RisedTextOut(Canvas: TDpiCanvas; X, Y: Integer; S: string); 80 procedure LightGradient(Canvas: TDpiCanvas; X, Y, Width, Color: Integer); 81 procedure DarkGradient(Canvas: TDpiCanvas; X, Y, Width, Kind: Integer); 82 procedure VLightGradient(Canvas: TDpiCanvas; X, Y, Height, Color: Integer); 83 procedure VDarkGradient(Canvas: TDpiCanvas; X, Y, Height, Kind: Integer); 85 84 procedure UnderlinedTitleValue(Canvas: TDpiCanvas; Title, Value: string; X, Y, Width: Integer); 86 procedure NumberBar(dst: TDpiBitmap; x, y: integer; Cap: string; val: integer;85 procedure NumberBar(dst: TDpiBitmap; X, Y: Integer; Cap: string; val: Integer; 87 86 T: TTexture); 88 procedure CountBar(dst: TDpiBitmap; x, y, w: integer; Kind: integer;89 Cap: string; val: integer; T: TTexture);90 procedure PaintProgressBar( ca: TDpiCanvas; Kind, x, y, pos, Growth, max: integer;87 procedure CountBar(dst: TDpiBitmap; X, Y, W: Integer; Kind: Integer; 88 Cap: string; val: Integer; T: TTexture); 89 procedure PaintProgressBar(Canvas: TDpiCanvas; Kind, X, Y, Pos, Growth, Max: Integer; 91 90 T: TTexture); 92 procedure PaintRelativeProgressBar( ca: TDpiCanvas;93 Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;91 procedure PaintRelativeProgressBar(Canvas: TDpiCanvas; 92 Kind, X, Y, size, Pos, Growth, Max: Integer; IndicateComplete: Boolean; 94 93 T: TTexture); 95 procedure PaintLogo(Canvas: TDpiCanvas; X, Y, LightColor, ShadeColor: integer);94 procedure PaintLogo(Canvas: TDpiCanvas; X, Y, LightColor, ShadeColor: Integer); 96 95 procedure LoadPhrases; 97 96 procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Cardinal); … … 149 148 Phrases2: TStringTable; 150 149 GrExt: TGraphicSets; 150 151 151 HGrSystem: TGraphicSet; 152 HGrSystem2: TGraphicSet;153 ClickFrameColor: Integer;154 MainTexture: TTexture;155 Templates: TGraphicSet;156 Colors: TDpiBitmap;157 Paper: TDpiBitmap;158 BigImp: TDpiBitmap;159 LogoBuffer: TDpiBitmap;160 FullScreen: Boolean;161 GenerateNames: Boolean;162 InitOrnamentDone: Boolean;163 Phrases2FallenBackToEnglish: Boolean;164 165 // Graphic set items166 152 CityMark1: TGraphicSetItem; 167 153 CityMark2: TGraphicSetItem; 154 155 HGrSystem2: TGraphicSet; 168 156 Ornament: TGraphicSetItem; 157 GBrainNoTerm: TGraphicSetItem; 158 GBrainSuperVirtual: TGraphicSetItem; 159 GBrainTerm: TGraphicSetItem; 160 GBrainRandom: TGraphicSetItem; 161 162 Templates: TGraphicSet; 169 163 Logo: TGraphicSetItem; 170 164 BigBook: TGraphicSetItem; … … 180 174 WeightOff: TGraphicSetItem; 181 175 176 ClickFrameColor: Integer; 177 MainTexture: TTexture; 178 Colors: TDpiBitmap; 179 Paper: TDpiBitmap; 180 BigImp: TDpiBitmap; 181 LogoBuffer: TDpiBitmap; 182 FullScreen: Boolean; 183 GenerateNames: Boolean; 184 InitOrnamentDone: Boolean; 185 Phrases2FallenBackToEnglish: Boolean; 186 182 187 UniFont: array [TFontType] of TDpiFont; 183 188 Gamma: Integer; // global gamma correction (cent) … … 192 197 193 198 uses 194 Directories, Sound, UPixelPointer;199 Directories, Sound, PixelPointer; 195 200 196 201 var 197 202 {$IFDEF WINDOWS} 198 203 StartResolution: TDeviceMode; 199 ResolutionChanged: boolean;204 ResolutionChanged: Boolean; 200 205 {$ENDIF} 201 206 … … 203 208 204 209 {$IFDEF WINDOWS} 205 function ChangeResolution( x, y, bpp, freq: integer): boolean;210 function ChangeResolution(X, Y, bpp, freq: Integer): Boolean; 206 211 var 207 212 DevMode: TDeviceMode; … … 210 215 DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or 211 216 DM_DISPLAYFREQUENCY; 212 DevMode.dmPelsWidth := x;213 DevMode.dmPelsHeight := y;217 DevMode.dmPelsWidth := X; 218 DevMode.dmPelsHeight := Y; 214 219 DevMode.dmBitsPerPel := bpp; 215 220 DevMode.dmDisplayFrequency := freq; … … 311 316 end; 312 317 313 procedure BtnFrame( ca: TDpiCanvas; p: TRect; T: TTexture);314 begin 315 RFrame( ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, T.ColorBevelShade,318 procedure BtnFrame(Canvas: TDpiCanvas; P: TRect; T: TTexture); 319 begin 320 RFrame(Canvas, P.Left - 1, P.Top - 1, P.Right, P.Bottom, T.ColorBevelShade, 316 321 T.ColorBevelLight); 317 322 end; 318 323 319 procedure EditFrame( ca: TDpiCanvas; p: TRect; T: TTexture);320 begin 321 Frame( ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, $000000, $000000);322 Frame( ca, p.Left - 2, p.Top - 2, p.Right + 1, p.Bottom + 1, $000000, $000000);323 Frame( ca, p.Left - 3, p.Top - 3, p.Right + 2, p.Bottom + 1, $000000, $000000);324 RFrame( ca, p.Left - 4, p.Top - 4, p.Right + 3, p.Bottom + 2, T.ColorBevelShade,324 procedure EditFrame(Canvas: TDpiCanvas; P: TRect; T: TTexture); 325 begin 326 Frame(Canvas, P.Left - 1, P.Top - 1, P.Right, P.Bottom, $000000, $000000); 327 Frame(Canvas, P.Left - 2, P.Top - 2, P.Right + 1, P.Bottom + 1, $000000, $000000); 328 Frame(Canvas, P.Left - 3, P.Top - 3, P.Right + 2, P.Bottom + 1, $000000, $000000); 329 RFrame(Canvas, P.Left - 4, P.Top - 4, P.Right + 3, P.Bottom + 2, T.ColorBevelShade, 325 330 T.ColorBevelLight); 326 331 end; … … 328 333 function HexCharToInt(X: Char): Integer; 329 334 begin 330 case xof335 case X of 331 336 '0' .. '9': Result := Ord(X) - Ord('0'); 332 337 'A' .. 'F': Result := Ord(X) - Ord('A') + 10; … … 364 369 begin 365 370 Bitmap.BeginUpdate; 366 PixelPtr := PixelPointer(Bitmap);371 PixelPtr := TPixelPointer.Create(Bitmap); 367 372 for Y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin 368 373 for X := 0 to ScaleToNative(Bitmap.Width) - 1 do begin … … 381 386 begin 382 387 //Dst.SetSize(Src.Width, Src.Height); 383 SrcPtr := PixelPointer(Src);384 DstPtr := PixelPointer(Dst);388 SrcPtr := TPixelPointer.Create(Src); 389 DstPtr := TPixelPointer.Create(Dst); 385 390 for Y := 0 to ScaleToNative(Src.Height - 1) do begin 386 391 for X := 0 to ScaleToNative(Src.Width - 1) do begin … … 483 488 end; 484 489 485 function LoadGraphicSet(const Name: string ): TGraphicSet;486 var 487 x: Integer;488 y: Integer;490 function LoadGraphicSet(const Name: string; Transparency: Boolean = True): TGraphicSet; 491 var 492 X: Integer; 493 Y: Integer; 489 494 OriginalColor: Integer; 490 495 FileName: string; … … 508 513 Result.ResetPixUsed; 509 514 510 Result.Mask.SetSize(Result.Data.Width, Result.Data.Height); 511 512 Result.Data.BeginUpdate; 513 Result.Mask.BeginUpdate; 514 DataPixel := PixelPointer(Result.Data); 515 MaskPixel := PixelPointer(Result.Mask); 516 for y := 0 to ScaleToNative(Result.Data.Height) - 1 do begin 517 for x := 0 to ScaleToNative(Result.Data.Width) - 1 do begin 518 OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF; 519 if (OriginalColor = TransparentColor1) or (OriginalColor = TransparentColor2) then begin 520 MaskPixel.Pixel^.R := $FF; 521 MaskPixel.Pixel^.G := $FF; 522 MaskPixel.Pixel^.B := $FF; 523 DataPixel.Pixel^.R := 0; 524 DataPixel.Pixel^.G := 0; 525 DataPixel.Pixel^.B := 0; 526 end else begin 527 MaskPixel.Pixel^.R := $00; 528 MaskPixel.Pixel^.G := $00; 529 MaskPixel.Pixel^.B := $00; 515 if Transparency then begin 516 Result.Mask.SetSize(Result.Data.Width, Result.Data.Height); 517 518 Result.Data.BeginUpdate; 519 Result.Mask.BeginUpdate; 520 DataPixel := TPixelPointer.Create(Result.Data); 521 MaskPixel := TPixelPointer.Create(Result.Mask); 522 for Y := 0 to ScaleToNative(Result.Data.Height) - 1 do begin 523 for X := 0 to ScaleToNative(Result.Data.Width) - 1 do begin 524 OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF; 525 if (OriginalColor = TransparentColor1) or (OriginalColor = TransparentColor2) then begin 526 MaskPixel.Pixel^.R := $FF; 527 MaskPixel.Pixel^.G := $FF; 528 MaskPixel.Pixel^.B := $FF; 529 DataPixel.Pixel^.R := 0; 530 DataPixel.Pixel^.G := 0; 531 DataPixel.Pixel^.B := 0; 532 end else begin 533 MaskPixel.Pixel^.R := $00; 534 MaskPixel.Pixel^.G := $00; 535 MaskPixel.Pixel^.B := $00; 536 end; 537 DataPixel.NextPixel; 538 MaskPixel.NextPixel; 530 539 end; 531 DataPixel.Next Pixel;532 MaskPixel.Next Pixel;540 DataPixel.NextLine; 541 MaskPixel.NextLine; 533 542 end; 534 DataPixel.NextLine; 535 MaskPixel.NextLine; 536 end; 537 Result.Data.EndUpdate; 538 Result.Mask.EndUpdate; 539 540 if Gamma <> 100 then 541 ApplyGammaToBitmap(Result.Data); 542 end; 543 end; 544 545 function LoadGraphicSet2(const Name: string): TGraphicSet; 546 var 547 FileName: string; 548 begin 549 Result := GrExt.SearchByName(Name); 550 if not Assigned(Result) then begin 551 Result := GrExt.AddNew(Name); 552 FileName := GetGraphicsDir + DirectorySeparator + Name; 553 if not LoadGraphicFile(Result.Data, FileName, [gfNoGamma]) then begin 554 Result := nil; 555 Exit; 556 end; 557 558 FileName := ExtractFileNameWithoutExt(FileName) + GraphicSetFileExt; 559 if FileExists(FileName) then 560 Result.LoadFromFile(FileName); 561 562 Result.ResetPixUsed; 563 end; 564 end; 565 566 procedure Dump(dst: TDpiBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 567 begin 568 DpiBitCanvas(dst.Canvas, xDst, yDst, Width, Height, 543 Result.Data.EndUpdate; 544 Result.Mask.EndUpdate; 545 546 if Gamma <> 100 then 547 ApplyGammaToBitmap(Result.Data); 548 end; 549 end; 550 end; 551 552 procedure Dump(dst: TDpiBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 553 begin 554 DpiBitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, 569 555 HGr.Data.Canvas, xGr, yGr); 570 556 end; … … 576 562 begin 577 563 Dst.BeginUpdate; 578 PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));564 PixelPtr := TPixelPointer.Create(Dst, ScaleToNative(X), ScaleToNative(Y)); 579 565 for YY := 0 to ScaleToNative(Height) - 1 do begin 580 566 for XX := 0 to ScaleToNative(Width) - 1 do begin … … 595 581 begin 596 582 Dst.BeginUpdate; 597 PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));583 PixelPtr := TPixelPointer.Create(Dst, ScaleToNative(X), ScaleToNative(Y)); 598 584 for yy := 0 to ScaleToNative(Height) - 1 do begin 599 585 for xx := 0 to ScaleToNative(Width) - 1 do begin … … 615 601 begin 616 602 Dst.BeginUpdate; 617 PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));603 PixelPtr := TPixelPointer.Create(Dst, ScaleToNative(X), ScaleToNative(Y)); 618 604 for YY := 0 to ScaleToNative(Height) - 1 do begin 619 605 for XX := 0 to ScaleToNative(Width) - 1 do begin … … 662 648 Height := ScaleToNative(dst.Height) - yDst; 663 649 if (Width < 0) or (Height < 0) then 664 exit;650 Exit; 665 651 666 652 dst.BeginUpdate; 667 653 Src.BeginUpdate; 668 PixelDst := PixelPointer(Dst, xDst, yDst);669 PixelSrc := PixelPointer(Src, xSrc, ySrc);654 PixelDst := TPixelPointer.Create(Dst, xDst, yDst); 655 PixelSrc := TPixelPointer.Create(Src, xSrc, ySrc); 670 656 for Y := 0 to Height - 1 do begin 671 657 for X := 0 to Width - 1 do begin 672 658 Brightness := PixelSrc.Pixel^.B; // One byte for 8-bit color 673 test := (PixelDst.Pixel^.R * Brightness) shr 7;674 if test >= 256 then659 Test := (PixelDst.Pixel^.R * Brightness) shr 7; 660 if Test >= 256 then 675 661 PixelDst.Pixel^.R := 255 676 662 else 677 PixelDst.Pixel^.R := test; // Red678 test := (PixelDst.Pixel^.G * Brightness) shr 7;679 if test >= 256 then663 PixelDst.Pixel^.R := Test; // Red 664 Test := (PixelDst.Pixel^.G * Brightness) shr 7; 665 if Test >= 256 then 680 666 PixelDst.Pixel^.G := 255 681 667 else 682 PixelDst.Pixel^.G := test; // Green683 test := (PixelDst.Pixel^.B * Brightness) shr 7;684 if test >= 256 then668 PixelDst.Pixel^.G := Test; // Green 669 Test := (PixelDst.Pixel^.B * Brightness) shr 7; 670 if Test >= 256 then 685 671 PixelDst.Pixel^.R := 255 686 672 else … … 728 714 Height := ScaleToNative(dst.Height) - yDst; 729 715 if (Width < 0) or (Height < 0) then 730 exit;716 Exit; 731 717 732 718 Src.BeginUpdate; 733 719 dst.BeginUpdate; 734 SrcPixel := PixelPointer(Src, xSrc, ySrc);735 DstPixel := PixelPointer(Dst, xDst, yDst);720 SrcPixel := TPixelPointer.Create(Src, xSrc, ySrc); 721 DstPixel := TPixelPointer.Create(Dst, xDst, yDst); 736 722 for iy := 0 to Height - 1 do begin 737 723 for ix := 0 to Width - 1 do begin … … 777 763 // R channel = Color2 amp 778 764 var 779 ix, iy, amp0, amp1, trans, Value: integer;765 ix, iy, amp0, amp1, trans, Value: Integer; 780 766 SrcPixel: TPixelPointer; 781 767 DstPixel: TPixelPointer; … … 789 775 Src.BeginUpdate; 790 776 Dst.BeginUpdate; 791 SrcPixel := PixelPointer(Src, xSrc, ySrc);792 DstPixel := PixelPointer(Dst, xDst, yDst);777 SrcPixel := TPixelPointer.Create(Src, xSrc, ySrc); 778 DstPixel := TPixelPointer.Create(Dst, xDst, yDst); 793 779 for iy := 0 to Height - 1 do begin 794 780 for ix := 0 to Width - 1 do begin … … 819 805 end; 820 806 821 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer);807 procedure ImageOp_CCC(bmp: TDpiBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer); 822 808 // Bmp is template 823 809 // B channel = Color0 amp, 128=original brightness … … 825 811 // R channel = Color2 amp, 128=original brightness 826 812 var 827 i, Red, Green: Integer;813 I, Red, Green: Integer; 828 814 PixelPtr: TPixelPointer; 829 815 begin … … 833 819 Y := ScaleToNative(Y); 834 820 bmp.BeginUpdate; 835 assert(bmp.PixelFormat = pf24bit);836 Height := y+ Height;837 PixelPtr := PixelPointer(Bmp, x, y);838 while y< Height do begin839 for i:= 0 to Width - 1 do begin821 Assert(bmp.PixelFormat = pf24bit); 822 Height := Y + Height; 823 PixelPtr := TPixelPointer.Create(Bmp, X, Y); 824 while Y < Height do begin 825 for I := 0 to Width - 1 do begin 840 826 Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G * 841 827 (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff; … … 850 836 PixelPtr.NextPixel; 851 837 end; 852 Inc( y);838 Inc(Y); 853 839 PixelPtr.NextLine; 854 840 end; … … 856 842 end; 857 843 858 procedure Sprite(Canvas: TDpiCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);859 begin 860 DpiBit Canvas(Canvas, xDst, yDst, Width, Height,844 procedure Sprite(Canvas: TDpiCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 845 begin 846 DpiBitBltCanvas(Canvas, xDst, yDst, Width, Height, 861 847 HGr.Mask.Canvas, xGr, yGr, SRCAND); 862 DpiBit Canvas(Canvas, xDst, yDst, Width, Height,848 DpiBitBltCanvas(Canvas, xDst, yDst, Width, Height, 863 849 HGr.Data.Canvas, xGr, yGr, SRCPAINT); 864 850 end; 865 851 866 procedure Sprite(dst: TDpiBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);867 begin 868 DpiBit Canvas(dst.Canvas, xDst, yDst, Width, Height,852 procedure Sprite(dst: TDpiBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 853 begin 854 DpiBitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, 869 855 HGr.Mask.Canvas, xGr, yGr, SRCAND); 870 DpiBit Canvas(dst.Canvas, xDst, yDst, Width, Height,856 DpiBitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, 871 857 HGr.Data.Canvas, xGr, yGr, SRCPAINT); 872 858 end; 873 859 874 function DpiBit Canvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer;860 function DpiBitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer; 875 861 SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; 876 862 begin … … 883 869 end; 884 870 885 function DpiBit Canvas(Dest: TDpiCanvas; DestRect: TRect; Src: TDpiCanvas;871 function DpiBitBltCanvas(Dest: TDpiCanvas; DestRect: TRect; Src: TDpiCanvas; 886 872 SrcPos: TPoint; Rop: DWORD): Boolean; 887 873 begin 888 Result := DpiBit Canvas(Dest, DestRect.Left, DestRect.Top, DestRect.Width, DestRect.Height,874 Result := DpiBitBltCanvas(Dest, DestRect.Left, DestRect.Top, DestRect.Width, DestRect.Height, 889 875 Src, SrcPos.X, SrcPos.Y, Rop); 890 876 end; … … 893 879 Src: TDpiBitmap; XSrc, YSrc: Integer; Rop: DWORD): Boolean; 894 880 begin 895 Result := DpiBit Canvas(Dest.Canvas, X, Y, Width, Height, Src.Canvas, XSrc, YSrc, Rop);881 Result := DpiBitBltCanvas(Dest.Canvas, X, Y, Width, Height, Src.Canvas, XSrc, YSrc, Rop); 896 882 end; 897 883 … … 899 885 SrcPos: TPoint; Rop: DWORD): Boolean; 900 886 begin 901 Result := DpiBit Canvas(Dest.Canvas, DestRect, Src.Canvas, SrcPos, Rop);902 end; 903 904 procedure SLine( ca: TDpiCanvas; x0, x1, y: integer; cl: TColor);905 begin 906 with cado begin887 Result := DpiBitBltCanvas(Dest.Canvas, DestRect, Src.Canvas, SrcPos, Rop); 888 end; 889 890 procedure SLine(Canvas: TDpiCanvas; x0, x1, Y: Integer; cl: TColor); 891 begin 892 with Canvas do begin 907 893 Pen.Color := cl; 908 MoveTo(x0, y);909 LineTo(x1 + 1, y);910 end; 911 end; 912 913 procedure DLine( ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor);914 begin 915 with cado begin894 MoveTo(x0, Y); 895 LineTo(x1 + 1, Y); 896 end; 897 end; 898 899 procedure DLine(Canvas: TDpiCanvas; x0, x1, Y: Integer; cl0, cl1: TColor); 900 begin 901 with Canvas do begin 916 902 Pen.Color := cl0; 917 MoveTo(x0, y);918 LineTo(x1, y);903 MoveTo(x0, Y); 904 LineTo(x1, Y); 919 905 Pen.Color := cl1; 920 MoveTo(x0 + 1, y+ 1);921 LineTo(x1 + 1, y+ 1);922 Pixels[x0, y+ 1] := cl0;923 Pixels[x1, y] := cl1;924 end; 925 end; 926 927 procedure Frame( ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);928 begin 929 with cado begin906 MoveTo(x0 + 1, Y + 1); 907 LineTo(x1 + 1, Y + 1); 908 Pixels[x0, Y + 1] := cl0; 909 Pixels[x1, Y] := cl1; 910 end; 911 end; 912 913 procedure Frame(Canvas: TDpiCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor); 914 begin 915 with Canvas do begin 930 916 MoveTo(x0, y1); 931 917 Pen.Color := cl0; … … 938 924 end; 939 925 940 procedure RFrame( ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);941 begin 942 with cado begin926 procedure RFrame(Canvas: TDpiCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor); 927 begin 928 with Canvas do begin 943 929 Pen.Color := cl0; 944 930 MoveTo(x0, y0 + 1); … … 954 940 end; 955 941 956 procedure CFrame( ca: TDpiCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);957 begin 958 with cado begin942 procedure CFrame(Canvas: TDpiCanvas; x0, y0, x1, y1, Corner: Integer; cl: TColor); 943 begin 944 with Canvas do begin 959 945 Pen.Color := cl; 960 946 MoveTo(x0, y0 + Corner - 1); … … 973 959 end; 974 960 975 procedure FrameImage( ca: TDpiCanvas; Src: TDpiBitmap;976 x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);961 procedure FrameImage(Canvas: TDpiCanvas; Src: TDpiBitmap; 962 X, Y, Width, Height, xSrc, ySrc: Integer; IsControl: Boolean = False); 977 963 begin 978 964 if IsControl then begin 979 Frame( ca, x - 1, y - 1, x + Width, y+ Height, $B0B0B0, $FFFFFF);980 RFrame( ca, x - 2, y - 2, x + Width + 1, y+ Height + 1, $FFFFFF, $B0B0B0);965 Frame(Canvas, X - 1, Y - 1, X + Width, Y + Height, $B0B0B0, $FFFFFF); 966 RFrame(Canvas, X - 2, Y - 2, X + Width + 1, Y + Height + 1, $FFFFFF, $B0B0B0); 981 967 end else 982 Frame( ca, x - 1, y - 1, x + Width, y+ Height, $000000, $000000);983 DpiBit Canvas(ca, x, y, Width, Height, Src.Canvas, xSrc, ySrc);968 Frame(Canvas, X - 1, Y - 1, X + Width, Y + Height, $000000, $000000); 969 DpiBitBltCanvas(Canvas, X, Y, Width, Height, Src.Canvas, xSrc, ySrc); 984 970 end; 985 971 986 972 procedure GlowFrame(Dst: TDpiBitmap; x0, y0, Width, Height: Integer; cl: TColor); 987 973 var 988 x, y, ch, r: Integer;974 X, Y, ch, R: Integer; 989 975 DstPtr: TPixelPointer; 990 976 DpiGlowRange: Integer; … … 996 982 Height := ScaleToNative(Height); 997 983 Dst.BeginUpdate; 998 DstPtr := PixelPointer(Dst, x0 - DpiGlowRange + 1, y0 - DpiGlowRange + 1);999 for y:= -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin1000 for x:= -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin1001 if x< 0 then1002 if y< 0 then1003 r := round(sqrt(sqr(x) + sqr(y)))1004 else if y>= Height then1005 r := round(sqrt(sqr(x) + sqr(y- (Height - 1))))984 DstPtr := TPixelPointer.Create(Dst, x0 - DpiGlowRange + 1, y0 - DpiGlowRange + 1); 985 for Y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin 986 for X := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin 987 if X < 0 then 988 if Y < 0 then 989 R := round(sqrt(sqr(X) + sqr(Y))) 990 else if Y >= Height then 991 R := round(sqrt(sqr(X) + sqr(Y - (Height - 1)))) 1006 992 else 1007 r := -x1008 else if x>= Width then1009 if y< 0 then1010 r := round(sqrt(sqr(x - (Width - 1)) + sqr(y)))1011 else if y>= Height then1012 r := round(sqrt(sqr(x - (Width - 1)) + sqr(y- (Height - 1))))993 R := -X 994 else if X >= Width then 995 if Y < 0 then 996 R := round(sqrt(sqr(X - (Width - 1)) + sqr(Y))) 997 else if Y >= Height then 998 R := round(sqrt(sqr(X - (Width - 1)) + sqr(Y - (Height - 1)))) 1013 999 else 1014 r := x- (Width - 1)1015 else if y< 0 then1016 r := -y1017 else if y>= Height then1018 r := y- (Height - 1)1000 R := X - (Width - 1) 1001 else if Y < 0 then 1002 R := -Y 1003 else if Y >= Height then 1004 R := Y - (Height - 1) 1019 1005 else begin 1020 1006 DstPtr.NextPixel; 1021 1007 continue; 1022 1008 end; 1023 if r= 0 then1024 r:= 1;1025 if r< DpiGlowRange then1009 if R = 0 then 1010 R := 1; 1011 if R < DpiGlowRange then 1026 1012 for ch := 0 to 2 do 1027 1013 DstPtr.Pixel^.Planes[2 - ch] := 1028 (DstPtr.Pixel^.Planes[2 - ch] * ( r- 1) + (cl shr (8 * ch) and $FF) *1029 (DpiGlowRange - r)) div (DpiGlowRange - 1);1014 (DstPtr.Pixel^.Planes[2 - ch] * (R - 1) + (cl shr (8 * ch) and $FF) * 1015 (DpiGlowRange - R)) div (DpiGlowRange - 1); 1030 1016 DstPtr.NextPixel; 1031 1017 end; … … 1048 1034 MainTexture.ColorBevelLight and $FCFCFC shr 2); 1049 1035 HGrSystem2.Data.BeginUpdate; 1050 PixelPtr := PixelPointer(HGrSystem2.Data, ScaleToNative(Ornament.Left), ScaleToNative(Ornament.Top)); 1036 PixelPtr := TPixelPointer.Create(HGrSystem2.Data, ScaleToNative(Ornament.Left), 1037 ScaleToNative(Ornament.Top)); 1051 1038 if PixelPtr.BytesPerPixel = 3 then begin 1052 1039 for Y := 0 to ScaleToNative(Ornament.Height) - 1 do begin … … 1074 1061 end; 1075 1062 1076 procedure InitCityMark(T : TTexture);1077 var 1078 x: Integer;1079 y: Integer;1063 procedure InitCityMark(Texture: TTexture); 1064 var 1065 X: Integer; 1066 Y: Integer; 1080 1067 Intensity: Integer; 1081 1068 begin 1082 for x:= 0 to CityMark1.Width - 1 do begin1083 for y:= 0 to CityMark1.Height - 1 do begin1084 if HGrSystem.Mask.Canvas.Pixels[CityMark1.Left + x, CityMark1.Top + y] = 0 then1069 for X := 0 to CityMark1.Width - 1 do begin 1070 for Y := 0 to CityMark1.Height - 1 do begin 1071 if HGrSystem.Mask.Canvas.Pixels[CityMark1.Left + X, CityMark1.Top + Y] = 0 then 1085 1072 begin 1086 1073 Intensity := HGrSystem.Data.Canvas.Pixels[CityMark1.Left + 1087 x, CityMark1.Top + y] and $FF;1088 HGrSystem.Data.Canvas.Pixels[CityMark2.Left + x, CityMark2.Top + y] :=1089 T .ColorMark and $FF * Intensity div $FF + T.ColorMark shr 8 and1090 $FF * Intensity div $FF shl 8 + T .ColorMark shr 16 and1074 X, CityMark1.Top + Y] and $FF; 1075 HGrSystem.Data.Canvas.Pixels[CityMark2.Left + X, CityMark2.Top + Y] := 1076 Texture.ColorMark and $FF * Intensity div $FF + Texture.ColorMark shr 8 and 1077 $FF * Intensity div $FF shl 8 + Texture.ColorMark shr 16 and 1091 1078 $FF * Intensity div $FF shl 16; 1092 1079 end; 1093 1080 end; 1094 1081 end; 1095 DpiBit Canvas(HGrSystem.Mask.Canvas, CityMark2.Left, CityMark2.Top, CityMark1.Width, CityMark1.Width,1082 DpiBitBltCanvas(HGrSystem.Mask.Canvas, CityMark2.Left, CityMark2.Top, CityMark1.Width, CityMark1.Width, 1096 1083 HGrSystem.Mask.Canvas, CityMark1.Left, CityMark1.Top); 1097 1084 end; 1098 1085 1099 procedure Fill( ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);1100 begin 1101 Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= MainTexture.Width) and1102 (Top + yOffset >= 0) and (Top + yOffset + Height <= MainTexture.Height));1103 DpiBit Canvas(ca, Left, Top, Width, Height, MainTexture.Image.Canvas,1086 procedure Fill(Canvas: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer); 1087 begin 1088 //Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= MainTexture.Width) and 1089 // (Top + yOffset >= 0) and (Top + yOffset + Height <= MainTexture.Height)); 1090 DpiBitBltCanvas(Canvas, Left, Top, Width, Height, MainTexture.Image.Canvas, 1104 1091 Left + xOffset, Top + yOffset); 1105 1092 end; … … 1110 1097 end; 1111 1098 1112 procedure FillLarge( ca: TDpiCanvas; x0, y0, x1, y1, xm: Integer);1099 procedure FillLarge(Canvas: TDpiCanvas; x0, y0, x1, y1, xm: Integer); 1113 1100 1114 1101 function Band(I: Integer): Integer; 1115 1102 var 1116 n: integer;1103 N: Integer; 1117 1104 begin 1118 n:= ((MainTexture.Height div 2) div (y1 - y0)) * 2;1105 N := ((MainTexture.Height div 2) div (y1 - y0)) * 2; 1119 1106 while MainTexture.Height div 2 + (I + 1) * (y1 - y0) > MainTexture.Height do 1120 Dec(I, n);1107 Dec(I, N); 1121 1108 while MainTexture.Height div 2 + I * (y1 - y0) < 0 do 1122 Inc(I, n);1109 Inc(I, N); 1123 1110 Result := I; 1124 1111 end; … … 1128 1115 begin 1129 1116 for I := 0 to (x1 - xm) div MainTexture.Width - 1 do 1130 DpiBit Canvas(ca, xm + I * MainTexture.Width, y0, MainTexture.Width, y1 - y0,1117 DpiBitBltCanvas(Canvas, xm + I * MainTexture.Width, y0, MainTexture.Width, y1 - y0, 1131 1118 MainTexture.Image.Canvas, 0, MainTexture.Height div 2 + Band(I) * 1132 1119 (y1 - y0)); 1133 DpiBit Canvas(ca, xm + ((x1 - xm) div MainTexture.Width) * MainTexture.Width, y0,1120 DpiBitBltCanvas(Canvas, xm + ((x1 - xm) div MainTexture.Width) * MainTexture.Width, y0, 1134 1121 x1 - (xm + ((x1 - xm) div MainTexture.Width) * MainTexture.Width), y1 - y0, 1135 1122 MainTexture.Image.Canvas, 0, MainTexture.Height div 2 + Band( 1136 1123 (x1 - xm) div MainTexture.Width) * (y1 - y0)); 1137 1124 for I := 0 to (xm - x0) div MainTexture.Width - 1 do 1138 DpiBit Canvas(ca, xm - (I + 1) * MainTexture.Width, y0, MainTexture.Width, y1 - y0,1125 DpiBitBltCanvas(Canvas, xm - (I + 1) * MainTexture.Width, y0, MainTexture.Width, y1 - y0, 1139 1126 MainTexture.Image.Canvas, 0, MainTexture.Height div 2 + 1140 1127 Band(-I - 1) * (y1 - y0)); 1141 DpiBit Canvas(ca, x0, y0, xm - ((xm - x0) div MainTexture.Width) *1128 DpiBitBltCanvas(Canvas, x0, y0, xm - ((xm - x0) div MainTexture.Width) * 1142 1129 MainTexture.Width - x0, y1 - y0, MainTexture.Image.Canvas, 1143 1130 ((xm - x0) div MainTexture.Width + 1) * MainTexture.Width - (xm - x0), … … 1145 1132 end; 1146 1133 1147 procedure FillSeamless( ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;1134 procedure FillSeamless(Canvas: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer; 1148 1135 const Texture: TDpiBitmap); 1149 1136 var 1150 x, y, x0cut, y0cut, x1cut, y1cut: Integer;1137 X, Y, x0cut, y0cut, x1cut, y1cut: Integer; 1151 1138 begin 1152 1139 while xOffset < 0 do … … 1154 1141 while yOffset < 0 do 1155 1142 Inc(yOffset, Texture.Height); 1156 for y:= (Top + yOffset) div Texture.Height to (Top + yOffset + Height - 1) div1143 for Y := (Top + yOffset) div Texture.Height to (Top + yOffset + Height - 1) div 1157 1144 Texture.Height do 1158 1145 begin 1159 y0cut := Top + yOffset - y* Texture.Height;1146 y0cut := Top + yOffset - Y * Texture.Height; 1160 1147 if y0cut < 0 then 1161 1148 y0cut := 0; 1162 y1cut := ( y+ 1) * Texture.Height - (Top + yOffset + Height);1149 y1cut := (Y + 1) * Texture.Height - (Top + yOffset + Height); 1163 1150 if y1cut < 0 then 1164 1151 y1cut := 0; 1165 for x:= (Left + xOffset) div Texture.Width to (Left + xOffset + Width - 1) div1152 for X := (Left + xOffset) div Texture.Width to (Left + xOffset + Width - 1) div 1166 1153 Texture.Width do 1167 1154 begin 1168 x0cut := Left + xOffset - x* Texture.Width;1155 x0cut := Left + xOffset - X * Texture.Width; 1169 1156 if x0cut < 0 then 1170 1157 x0cut := 0; 1171 x1cut := ( x+ 1) * Texture.Width - (Left + xOffset + Width);1158 x1cut := (X + 1) * Texture.Width - (Left + xOffset + Width); 1172 1159 if x1cut < 0 then 1173 1160 x1cut := 0; 1174 DpiBit Canvas(ca, x* Texture.Width + x0cut - xOffset,1175 y* Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut,1161 DpiBitBltCanvas(Canvas, X * Texture.Width + x0cut - xOffset, 1162 Y * Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut, 1176 1163 Texture.Height - y0cut - y1cut, Texture.Canvas, x0cut, y0cut); 1177 1164 end; … … 1179 1166 end; 1180 1167 1181 procedure FillRectSeamless( ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;1168 procedure FillRectSeamless(Canvas: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer; 1182 1169 const Texture: TDpiBitmap); 1183 1170 begin 1184 FillSeamless( ca, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture);1171 FillSeamless(Canvas, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture); 1185 1172 end; 1186 1173 … … 1191 1178 end; 1192 1179 1193 procedure Corner( ca: TDpiCanvas; x, y, Kind: Integer; T: TTexture);1194 begin 1195 { DpiBit Canvas(ca,x,y,8,8,T.HGr.Mask.Canvas,1180 procedure Corner(Canvas: TDpiCanvas; X, Y, Kind: Integer; T: TTexture); 1181 begin 1182 { DpiBitBltCanvas(Canvas,x,y,8,8,T.HGr.Mask.Canvas, 1196 1183 T.xGr+29+Kind*9,T.yGr+89,SRCAND); 1197 DpiBit Canvas(ca,x,y,8,8,T.HGr.Data.Canvas,1184 DpiBitBltCanvas(Canvas,X,Y,8,8,T.HGr.Data.Canvas, 1198 1185 T.xGr+29+Kind*9,T.yGr+89,SRCPAINT); } 1199 1186 end; 1200 1187 1201 procedure BiColorTextOut( ca: TDpiCanvas; clMain, clBack: TColor; x, y: Integer; s: string);1202 1203 procedure PaintIcon( x, y, Kind: Integer);1188 procedure BiColorTextOut(Canvas: TDpiCanvas; clMain, clBack: TColor; X, Y: Integer; S: string); 1189 1190 procedure PaintIcon(X, Y, Kind: Integer); 1204 1191 begin 1205 DpiBit Canvas(ca, x, y+ 6, 10, 10, HGrSystem.Mask.Canvas,1192 DpiBitBltCanvas(Canvas, X, Y + 6, 10, 10, HGrSystem.Mask.Canvas, 1206 1193 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND); 1207 DpiBit Canvas(ca, x, y+ 6, 10, 10, HGrSystem.Data.Canvas,1194 DpiBitBltCanvas(Canvas, X, Y + 6, 10, 10, HGrSystem.Data.Canvas, 1208 1195 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT); 1209 1196 end; 1210 1197 1211 1198 var 1212 p, xp: Integer;1199 P, xp: Integer; 1213 1200 sp: string; 1214 1201 shadow: Boolean; 1215 1202 Text: string; 1216 1203 begin 1217 Inc( x);1218 Inc( y);1204 Inc(X); 1205 Inc(Y); 1219 1206 for shadow := True downto False do 1220 with cado1207 with Canvas do 1221 1208 if not shadow or (clBack <> $7F007F) then 1222 1209 begin … … 1225 1212 else 1226 1213 Font.Color := clMain; 1227 sp := s;1228 xp := x;1214 sp := S; 1215 xp := X; 1229 1216 repeat 1230 p := pos('%', sp);1231 if ( p = 0) or (p+ 1 > Length(sp)) or not1232 (sp[ p+ 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) then1217 P := Pos('%', sp); 1218 if (P = 0) or (P + 1 > Length(sp)) or not 1219 (sp[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) then 1233 1220 begin 1234 ca.Textout(xp, y, sp);1221 Canvas.Textout(xp, Y, sp); 1235 1222 Break; 1236 1223 end 1237 1224 else 1238 1225 begin 1239 Text := Copy(sp, 1, p- 1);1240 Textout(xp, y, Text);1241 Inc(xp, ca.TextWidth(Text));1226 Text := Copy(sp, 1, P - 1); 1227 Textout(xp, Y, Text); 1228 Inc(xp, Canvas.TextWidth(Text)); 1242 1229 if not shadow then 1243 case sp[ p+ 1] of1244 'c': PaintIcon(xp + 1, y, 6);1245 'f': PaintIcon(xp + 1, y, 0);1246 'l': PaintIcon(xp + 1, y, 8);1247 'm': PaintIcon(xp + 1, y, 17);1248 'n': PaintIcon(xp + 1, y, 7);1249 'o': PaintIcon(xp + 1, y, 16);1250 'p': PaintIcon(xp + 1, y, 2);1251 'r': PaintIcon(xp + 1, y, 12);1252 't': PaintIcon(xp + 1, y, 4);1253 'w': PaintIcon(xp + 1, y, 13);1230 case sp[P + 1] of 1231 'c': PaintIcon(xp + 1, Y, 6); 1232 'f': PaintIcon(xp + 1, Y, 0); 1233 'l': PaintIcon(xp + 1, Y, 8); 1234 'm': PaintIcon(xp + 1, Y, 17); 1235 'n': PaintIcon(xp + 1, Y, 7); 1236 'o': PaintIcon(xp + 1, Y, 16); 1237 'p': PaintIcon(xp + 1, Y, 2); 1238 'r': PaintIcon(xp + 1, Y, 12); 1239 't': PaintIcon(xp + 1, Y, 4); 1240 'w': PaintIcon(xp + 1, Y, 13); 1254 1241 end; 1255 1242 Inc(xp, 10); 1256 Delete(sp, 1, p+ 1);1243 Delete(sp, 1, P + 1); 1257 1244 end; 1258 1245 until False; 1259 Dec( x);1260 Dec( y);1246 Dec(X); 1247 Dec(Y); 1261 1248 end; 1262 1249 end; 1263 1250 1264 function BiColorTextWidth( ca: TDpiCanvas; s: string): Integer;1251 function BiColorTextWidth(Canvas: TDpiCanvas; S: string): Integer; 1265 1252 var 1266 1253 P: Integer; … … 1268 1255 Result := 1; 1269 1256 repeat 1270 P := Pos('%', s);1271 if (P = 0) or (P = Length( s)) then1257 P := Pos('%', S); 1258 if (P = 0) or (P = Length(S)) then 1272 1259 begin 1273 Inc(Result, ca.TextWidth(s));1260 Inc(Result, Canvas.TextWidth(S)); 1274 1261 Break; 1275 1262 end 1276 1263 else 1277 1264 begin 1278 if not ( s[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])1265 if not (S[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) 1279 1266 then 1280 Inc(Result, ca.TextWidth(copy(s, 1, P + 1)))1267 Inc(Result, Canvas.TextWidth(Copy(S, 1, P + 1))) 1281 1268 else 1282 Inc(Result, ca.TextWidth(copy(s, 1, P - 1)) + 10);1283 Delete( s, 1, P + 1);1269 Inc(Result, Canvas.TextWidth(Copy(S, 1, P - 1)) + 10); 1270 Delete(S, 1, P + 1); 1284 1271 end; 1285 1272 until False; 1286 1273 end; 1287 1274 1288 procedure LoweredTextOut( ca: TDpiCanvas; cl: TColor; T: TTexture;1289 x, y: Integer; s: string);1275 procedure LoweredTextOut(Canvas: TDpiCanvas; cl: TColor; T: TTexture; 1276 X, Y: Integer; S: string); 1290 1277 begin 1291 1278 if cl = -2 then 1292 BiColorTextOut( ca, (T.ColorBevelShade and $FEFEFE) shr 1,1293 T.ColorBevelLight, x, y, s)1279 BiColorTextOut(Canvas, (T.ColorBevelShade and $FEFEFE) shr 1, 1280 T.ColorBevelLight, X, Y, S) 1294 1281 else if cl < 0 then 1295 BiColorTextOut( ca, T.ColorTextShade, T.ColorTextLight, x, y, s)1282 BiColorTextOut(Canvas, T.ColorTextShade, T.ColorTextLight, X, Y, S) 1296 1283 else 1297 BiColorTextOut( ca, cl, T.ColorTextLight, x, y, s);1298 end; 1299 1300 procedure RisedTextOut( ca: TDpiCanvas; x, y: integer; s: string);1301 begin 1302 BiColorTextOut( ca, $FFFFFF, $000000, x, y, s);1303 end; 1304 1305 procedure Gradient( ca: TDpiCanvas; x, y, dx, dy, Width, Height, Color: Integer;1306 Brightness: array of integer);1307 var 1308 i, r, g, b: Integer;1309 begin 1310 for i:= 0 to Length(Brightness) - 1 do begin // gradient1311 r := Color and $FF + Brightness[i];1312 if r< 0 then1313 r:= 01314 else if r>= 256 then1315 r:= 255;1316 g := Color shr 8 and $FF + Brightness[i];1317 if g< 0 then1318 g:= 01319 else if g>= 256 then1320 g:= 255;1321 b := Color shr 16 and $FF + Brightness[i];1322 if b< 0 then1323 b:= 01324 else if b>= 256 then1325 b:= 255;1326 ca.Pen.Color := r + g shl 8 + bshl 16;1327 ca.MoveTo(x + dx * i, y + dy * i);1328 ca.LineTo(x + dx * i + Width, y + dy * i+ Height);1329 end; 1330 ca.Pen.Color := $000000;1331 ca.MoveTo(x + 1, y+ 16 * dy + Height);1332 ca.LineTo(x + 16 * dx + Width, y+ 16 * dy + Height);1333 ca.LineTo(x + 16 * dx + Width, y);1334 end; 1335 1336 procedure LightGradient( ca: TDpiCanvas; x, y, Width, Color: Integer);1284 BiColorTextOut(Canvas, cl, T.ColorTextLight, X, Y, S); 1285 end; 1286 1287 procedure RisedTextOut(Canvas: TDpiCanvas; X, Y: Integer; S: string); 1288 begin 1289 BiColorTextOut(Canvas, $FFFFFF, $000000, X, Y, S); 1290 end; 1291 1292 procedure Gradient(Canvas: TDpiCanvas; X, Y, dx, dy, Width, Height, Color: Integer; 1293 Brightness: array of Integer); 1294 var 1295 I, R, G, B: Integer; 1296 begin 1297 for I := 0 to Length(Brightness) - 1 do begin // gradient 1298 R := Color and $FF + Brightness[I]; 1299 if R < 0 then 1300 R := 0 1301 else if R >= 256 then 1302 R := 255; 1303 G := Color shr 8 and $FF + Brightness[I]; 1304 if G < 0 then 1305 G := 0 1306 else if G >= 256 then 1307 G := 255; 1308 B := Color shr 16 and $FF + Brightness[I]; 1309 if B < 0 then 1310 B := 0 1311 else if B >= 256 then 1312 B := 255; 1313 Canvas.Pen.Color := R + G shl 8 + B shl 16; 1314 Canvas.MoveTo(X + dx * I, Y + dy * I); 1315 Canvas.LineTo(X + dx * I + Width, Y + dy * I + Height); 1316 end; 1317 Canvas.Pen.Color := $000000; 1318 Canvas.MoveTo(X + 1, Y + 16 * dy + Height); 1319 Canvas.LineTo(X + 16 * dx + Width, Y + 16 * dy + Height); 1320 Canvas.LineTo(X + 16 * dx + Width, Y); 1321 end; 1322 1323 procedure LightGradient(Canvas: TDpiCanvas; X, Y, Width, Color: Integer); 1337 1324 const 1338 Brightness: array [0 .. 15] of integer =1325 Brightness: array [0 .. 15] of Integer = 1339 1326 (16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44); 1340 1327 begin 1341 Gradient( ca, x, y, 0, 1, Width, 0, Color, Brightness);1342 end; 1343 1344 procedure DarkGradient( ca: TDpiCanvas; x, y, Width, Kind: Integer);1328 Gradient(Canvas, X, Y, 0, 1, Width, 0, Color, Brightness); 1329 end; 1330 1331 procedure DarkGradient(Canvas: TDpiCanvas; X, Y, Width, Kind: Integer); 1345 1332 const 1346 Brightness: array [0 .. 15] of integer =1333 Brightness: array [0 .. 15] of Integer = 1347 1334 (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44); 1348 1335 begin 1349 Gradient( ca, x, y, 0, 1, Width, 0, HGrSystem.Data.Canvas.Pixels1336 Gradient(Canvas, X, Y, 0, 1, Width, 0, HGrSystem.Data.Canvas.Pixels 1350 1337 [187, 137 + Kind], Brightness); 1351 1338 end; 1352 1339 1353 procedure VLightGradient( ca: TDpiCanvas; x, y, Height, Color: Integer);1340 procedure VLightGradient(Canvas: TDpiCanvas; X, Y, Height, Color: Integer); 1354 1341 const 1355 Brightness: array [0 .. 15] of integer =1342 Brightness: array [0 .. 15] of Integer = 1356 1343 (16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44); 1357 1344 begin 1358 Gradient( ca, x, y, 1, 0, 0, Height, Color, Brightness);1359 end; 1360 1361 procedure VDarkGradient( ca: TDpiCanvas; x, y, Height, Kind: Integer);1345 Gradient(Canvas, X, Y, 1, 0, 0, Height, Color, Brightness); 1346 end; 1347 1348 procedure VDarkGradient(Canvas: TDpiCanvas; X, Y, Height, Kind: Integer); 1362 1349 const 1363 Brightness: array [0 .. 15] of integer =1350 Brightness: array [0 .. 15] of Integer = 1364 1351 (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44); 1365 1352 begin 1366 Gradient( ca, x, y, 1, 0, 0, Height,1353 Gradient(Canvas, X, Y, 1, 0, 0, Height, 1367 1354 HGrSystem.Data.Canvas.Pixels[187, 137 + Kind], Brightness); 1368 1355 end; … … 1375 1362 end; 1376 1363 1377 procedure NumberBar(dst: TDpiBitmap; x, y: integer; Cap: string;1364 procedure NumberBar(dst: TDpiBitmap; X, Y: Integer; Cap: string; 1378 1365 val: Integer; T: TTexture); 1379 1366 var 1380 s: string;1367 S: string; 1381 1368 begin 1382 1369 if val > 0 then 1383 1370 begin 1384 DLine(dst.Canvas, x - 2, x + 170, y+ 16, T.ColorBevelShade,1371 DLine(dst.Canvas, X - 2, X + 170, Y + 16, T.ColorBevelShade, 1385 1372 T.ColorBevelLight); 1386 LoweredTextOut(dst.Canvas, -1, T, x - 2, y, Cap);1387 s:= IntToStr(val);1388 RisedTextOut(dst.Canvas, x+ 170 - BiColorTextWidth(dst.Canvas,1389 s), y, s);1390 end; 1391 end; 1392 1393 procedure CountBar(dst: TDpiBitmap; x, y, w: Integer; Kind: Integer;1373 LoweredTextOut(dst.Canvas, -1, T, X - 2, Y, Cap); 1374 S := IntToStr(val); 1375 RisedTextOut(dst.Canvas, X + 170 - BiColorTextWidth(dst.Canvas, 1376 S), Y, S); 1377 end; 1378 end; 1379 1380 procedure CountBar(dst: TDpiBitmap; X, Y, W: Integer; Kind: Integer; 1394 1381 Cap: string; val: Integer; T: TTexture); 1395 1382 var 1396 i, sd, ld, cl, xIcon, yIcon: Integer;1397 s: string;1383 I, sd, ld, cl, xIcon, yIcon: Integer; 1384 S: string; 1398 1385 begin 1399 1386 // val:=random(40); //!!! … … 1407 1394 // DLine(dst.Canvas,x-2,x+170+32,y+16,T.ColorBevelShade,T.ColorBevelLight); 1408 1395 1409 xIcon := x- 5;1410 yIcon := y+ 15;1411 DLine(dst.Canvas, x - 2, xIcon + w+ 2, yIcon + 16, T.ColorBevelShade,1396 xIcon := X - 5; 1397 yIcon := Y + 15; 1398 DLine(dst.Canvas, X - 2, xIcon + W + 2, yIcon + 16, T.ColorBevelShade, 1412 1399 T.ColorBevelLight); 1413 1400 1414 s:= IntToStr(val);1401 S := IntToStr(val); 1415 1402 if val < 0 then 1416 1403 cl := $0000FF 1417 1404 else 1418 1405 cl := -1; 1419 LoweredTextOut(dst.Canvas, cl, T, x - 2, y, Cap);1406 LoweredTextOut(dst.Canvas, cl, T, X - 2, Y, Cap); 1420 1407 LoweredTextOut(dst.Canvas, cl, T, 1421 xIcon + w + 2 - BiColorTextWidth(dst.Canvas, s), yIcon, s);1408 xIcon + W + 2 - BiColorTextWidth(dst.Canvas, S), yIcon, S); 1422 1409 1423 1410 if (Kind = 12) and (val >= 100) then … … 1427 1414 if sd = 0 then 1428 1415 sd := 1; 1429 if sd < w- 44 then1416 if sd < W - 44 then 1430 1417 ld := sd 1431 1418 else 1432 ld := w- 44;1433 for i:= 0 to val mod 10 - 1 do1419 ld := W - 44; 1420 for I := 0 to val mod 10 - 1 do 1434 1421 begin 1435 DpiBit Canvas(dst.Canvas, xIcon + 4 + i* (14 * ld div sd), yIcon + 2 + 1, 14,1422 DpiBitBltCanvas(dst.Canvas, xIcon + 4 + I * (14 * ld div sd), yIcon + 2 + 1, 14, 1436 1423 14, HGrSystem.Mask.Canvas, 67 + Kind mod 8 * 15, 1437 1424 70 + Kind div 8 * 15, SRCAND); 1438 Sprite(dst, HGrSystem, xIcon + 3 + i* (14 * ld div sd), yIcon + 2,1425 Sprite(dst, HGrSystem, xIcon + 3 + I * (14 * ld div sd), yIcon + 2, 1439 1426 14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15); 1440 1427 end; 1441 for i:= 0 to val div 10 - 1 do1428 for I := 0 to val div 10 - 1 do 1442 1429 begin 1443 DpiBit Canvas(dst.Canvas, xIcon + 4 + (val mod 10) *1444 (14 * ld div sd) + i* (14 * ld div sd), yIcon + 3, 14, 14,1430 DpiBitBltCanvas(dst.Canvas, xIcon + 4 + (val mod 10) * 1431 (14 * ld div sd) + I * (14 * ld div sd), yIcon + 3, 14, 14, 1445 1432 HGrSystem.Mask.Canvas, 67 + 7 mod 8 * 15, 1446 1433 70 + 7 div 8 * 15, SRCAND); 1447 1434 Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) * 1448 (14 * ld div sd) + i* (14 * ld div sd), yIcon + 2, 14,1435 (14 * ld div sd) + I * (14 * ld div sd), yIcon + 2, 14, 1449 1436 14, 67 + 7 mod 8 * 15, 1450 1437 70 + 7 div 8 * 15); … … 1460 1447 if sd = 0 then 1461 1448 sd := 1; 1462 if sd < w- 44 then1449 if sd < W - 44 then 1463 1450 ld := sd 1464 1451 else 1465 ld := w- 44;1466 for i:= 0 to val div 10 - 1 do1452 ld := W - 44; 1453 for I := 0 to val div 10 - 1 do 1467 1454 begin 1468 DpiBit Canvas(dst.Canvas, xIcon + 4 + i* (14 * ld div sd), yIcon + 3, 14, 14,1455 DpiBitBltCanvas(dst.Canvas, xIcon + 4 + I * (14 * ld div sd), yIcon + 3, 14, 14, 1469 1456 HGrSystem.Mask.Canvas, 67 + Kind mod 8 * 15, 1470 1457 70 + Kind div 8 * 15, SRCAND); 1471 Sprite(dst, HGrSystem, xIcon + 3 + i* (14 * ld div sd), yIcon + 2,1458 Sprite(dst, HGrSystem, xIcon + 3 + I * (14 * ld div sd), yIcon + 2, 1472 1459 14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15); 1473 1460 end; 1474 for i:= 0 to val mod 10 - 1 do1461 for I := 0 to val mod 10 - 1 do 1475 1462 begin 1476 DpiBit Canvas(dst.Canvas, xIcon + 4 + (val div 10) *1477 (14 * ld div sd) + i* (10 * ld div sd), yIcon + 7, 10, 10,1463 DpiBitBltCanvas(dst.Canvas, xIcon + 4 + (val div 10) * 1464 (14 * ld div sd) + I * (10 * ld div sd), yIcon + 7, 10, 10, 1478 1465 HGrSystem.Mask.Canvas, 66 + Kind mod 11 * 11, 1479 1466 115 + Kind div 11 * 11, SRCAND); 1480 1467 Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) * 1481 (14 * ld div sd) + i* (10 * ld div sd), yIcon + 6, 10,1468 (14 * ld div sd) + I * (10 * ld div sd), yIcon + 6, 10, 1482 1469 10, 66 + Kind mod 11 * 11, 1483 1470 115 + Kind div 11 * 11); … … 1487 1474 end; 1488 1475 1489 procedure PaintProgressBar( ca: TDpiCanvas; Kind, x, y, pos, Growth, max: Integer;1476 procedure PaintProgressBar(Canvas: TDpiCanvas; Kind, X, Y, Pos, Growth, Max: Integer; 1490 1477 T: TTexture); 1491 1478 var 1492 i: Integer;1493 begin 1494 if pos > max then1495 pos := max;1479 I: Integer; 1480 begin 1481 if Pos > Max then 1482 Pos := Max; 1496 1483 if Growth < 0 then 1497 1484 begin 1498 pos := pos + Growth;1499 if pos < 0 then1485 Pos := Pos + Growth; 1486 if Pos < 0 then 1500 1487 begin 1501 Growth := Growth - pos;1502 pos := 0;1488 Growth := Growth - Pos; 1489 Pos := 0; 1503 1490 end; 1504 1491 end 1505 else if pos + Growth > max then1506 Growth := max - pos;1507 Frame( ca, x - 1, y - 1, x + max, y+ 7, $000000, $000000);1508 RFrame( ca, x - 2, y - 2, x + max + 1, y+ 8, T.ColorBevelShade,1492 else if Pos + Growth > Max then 1493 Growth := Max - Pos; 1494 Frame(Canvas, X - 1, Y - 1, X + Max, Y + 7, $000000, $000000); 1495 RFrame(Canvas, X - 2, Y - 2, X + Max + 1, Y + 8, T.ColorBevelShade, 1509 1496 T.ColorBevelLight); 1510 with cado1497 with Canvas do 1511 1498 begin 1512 for i := 0 to pos div 8 - 1 do1513 DpiBit Canvas(ca, x + i * 8, y, 8, 7,1499 for I := 0 to Pos div 8 - 1 do 1500 DpiBitBltCanvas(Canvas, X + I * 8, Y, 8, 7, 1514 1501 HGrSystem.Data.Canvas, 104, 9 + 8 * Kind); 1515 DpiBit Canvas(ca, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,1502 DpiBitBltCanvas(Canvas, X + 8 * (Pos div 8), Y, Pos - 8 * (Pos div 8), 7, 1516 1503 HGrSystem.Data.Canvas, 104, 9 + 8 * Kind); 1517 1504 if Growth > 0 then 1518 1505 begin 1519 for i:= 0 to Growth div 8 - 1 do1520 DpiBit Canvas(ca, x + pos + i * 8, y, 8, 7,1506 for I := 0 to Growth div 8 - 1 do 1507 DpiBitBltCanvas(Canvas, X + Pos + I * 8, Y, 8, 7, 1521 1508 HGrSystem.Data.Canvas, 112, 9 + 8 * Kind); 1522 DpiBit Canvas(ca, x + pos + 8 * (Growth div 8), y,1509 DpiBitBltCanvas(Canvas, X + Pos + 8 * (Growth div 8), Y, 1523 1510 Growth - 8 * (Growth div 8), 7, HGrSystem.Data.Canvas, 1524 1511 112, 9 + 8 * Kind); … … 1526 1513 else if Growth < 0 then 1527 1514 begin 1528 for i:= 0 to -Growth div 8 - 1 do1529 DpiBit Canvas(ca, x + pos + i * 8, y, 8, 7,1515 for I := 0 to -Growth div 8 - 1 do 1516 DpiBitBltCanvas(Canvas, X + Pos + I * 8, Y, 8, 7, 1530 1517 HGrSystem.Data.Canvas, 104, 1); 1531 DpiBit Canvas(ca, x + pos + 8 * (-Growth div 8), y, -Growth -1518 DpiBitBltCanvas(Canvas, X + Pos + 8 * (-Growth div 8), Y, -Growth - 1532 1519 8 * (-Growth div 8), 7, 1533 1520 HGrSystem.Data.Canvas, 104, 1); 1534 1521 end; 1535 1522 Brush.Color := $000000; 1536 FillRect(Rect( x + pos + abs(Growth), y, x + max, y+ 7));1523 FillRect(Rect(X + Pos + abs(Growth), Y, X + Max, Y + 7)); 1537 1524 Brush.Style := bsClear; 1538 1525 end; … … 1540 1527 1541 1528 // pos and growth are relative to max, set size independent 1542 procedure PaintRelativeProgressBar( ca: TDpiCanvas;1543 Kind, x, y, size, pos, Growth, max: Integer; IndicateComplete: Boolean;1529 procedure PaintRelativeProgressBar(Canvas: TDpiCanvas; 1530 Kind, X, Y, size, Pos, Growth, Max: Integer; IndicateComplete: Boolean; 1544 1531 T: TTexture); 1545 1532 begin 1546 1533 if Growth > 0 then 1547 PaintProgressBar( ca, Kind, x, y, pos * size div max,1548 (Growth * size + max div 2) div max, size, T)1534 PaintProgressBar(Canvas, Kind, X, Y, Pos * size div Max, 1535 (Growth * size + Max div 2) div Max, size, T) 1549 1536 else 1550 PaintProgressBar( ca, Kind, x, y, pos * size div max,1551 (Growth * size - max div 2) div max, size, T);1552 if IndicateComplete and ( pos + Growth >= max) then1553 Sprite( ca, HGrSystem, x + size - 10, y- 7, 23, 16, 1, 129);1537 PaintProgressBar(Canvas, Kind, X, Y, Pos * size div Max, 1538 (Growth * size - Max div 2) div Max, size, T); 1539 if IndicateComplete and (Pos + Growth >= Max) then 1540 Sprite(Canvas, HGrSystem, X + size - 10, Y - 7, 23, 16, 1, 129); 1554 1541 end; 1555 1542 … … 1557 1544 begin 1558 1545 UnshareBitmap(LogoBuffer); 1559 DpiBit Canvas(LogoBuffer.Canvas, 0, 0, Logo.Width, Logo.Height, Canvas, X, Y);1546 DpiBitBltCanvas(LogoBuffer.Canvas, 0, 0, Logo.Width, Logo.Height, Canvas, X, Y); 1560 1547 ImageOp_BCC(LogoBuffer, Templates.Data, Point(0, 0), Logo.BoundsRect, 1561 1548 LightColor, ShadeColor); 1562 DpiBit Canvas(Canvas, X, Y, Logo.Width, Logo.Height, LogoBuffer.Canvas, 0, 0);1549 DpiBitBltCanvas(Canvas, X, Y, Logo.Width, Logo.Height, LogoBuffer.Canvas, 0, 0); 1563 1550 end; 1564 1551 … … 1602 1589 TexWidth := Texture.Width; 1603 1590 TexHeight := Texture.Height; 1604 DstPixel := PixelPointer(Dest);1605 SrcPixel := PixelPointer(Texture);1591 DstPixel := TPixelPointer.Create(Dest); 1592 SrcPixel := TPixelPointer.Create(Texture); 1606 1593 for Y := 0 to ScaleToNative(Dest.Height) - 1 do begin 1607 1594 for X := 0 to ScaleToNative(Dest.Width) - 1 do begin … … 1621 1608 procedure DarkenImage(Bitmap: TDpiBitmap; Change: Integer); 1622 1609 var 1623 x, y: integer;1610 X, Y: Integer; 1624 1611 PicturePixel: TPixelPointer; 1625 1612 begin 1626 1613 Bitmap.BeginUpdate; 1627 PicturePixel := PixelPointer(Bitmap);1628 for y:= 0 to ScaleToNative(Bitmap.Height) - 1 do begin1629 for x:= 0 to ScaleToNative(Bitmap.Width) - 1 do begin1614 PicturePixel := TPixelPointer.Create(Bitmap); 1615 for Y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin 1616 for X := 0 to ScaleToNative(Bitmap.Width) - 1 do begin 1630 1617 PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0); 1631 1618 PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0); … … 1645 1632 1646 1633 procedure Gtk2Fix; 1634 {$IFDEF UNIX} 1647 1635 var 1648 1636 I: Integer; 1649 begin 1650 {$IFDEF LINUX} 1637 {$ENDIF} 1638 begin 1639 {$IFDEF UNIX} 1651 1640 // Wait and process messages little bit to avoid crash or force repaint under Gtk2 1652 1641 for I := 0 to 10 do begin … … 1661 1650 Section: TFontType; 1662 1651 FontScript: TextFile; 1663 Size: integer;1652 Size: Integer; 1664 1653 S: string; 1665 I: integer;1666 P: integer;1654 I: Integer; 1655 P: Integer; 1667 1656 begin 1668 1657 Section := ftNormal; … … 1671 1660 Reset(FontScript); 1672 1661 while not Eof(FontScript) do begin 1673 ReadLn(FontScript, s);1674 if s<> '' then1675 if s[1] = '#' then begin1676 s := TrimRight(s);1677 if s= '#SMALL' then Section := ftSmall1678 else if s= '#TINY' then Section := ftTiny1679 else if s= '#CAPTION' then Section := ftCaption1680 else if s= '#BUTTON' then Section := ftButton1662 ReadLn(FontScript, S); 1663 if S <> '' then 1664 if S[1] = '#' then begin 1665 S := TrimRight(S); 1666 if S = '#SMALL' then Section := ftSmall 1667 else if S = '#TINY' then Section := ftTiny 1668 else if S = '#CAPTION' then Section := ftCaption 1669 else if S = '#BUTTON' then Section := ftButton 1681 1670 else Section := ftNormal; 1682 1671 end else begin 1683 p := Pos(',', s);1684 if p> 0 then begin1685 UniFont[section].Name := Trim(Copy( s, 1, p- 1));1672 P := Pos(',', S); 1673 if P > 0 then begin 1674 UniFont[section].Name := Trim(Copy(S, 1, P - 1)); 1686 1675 Size := 0; 1687 for i := p + 1 to Length(s) do1688 case s[i] of1676 for I := P + 1 to Length(S) do 1677 case S[I] of 1689 1678 '0' .. '9': 1690 Size := Size * 10 + Byte( s[i]) - 48;1679 Size := Size * 10 + Byte(S[I]) - 48; 1691 1680 'B', 'b': 1692 1681 UniFont[section].Style := UniFont[section].Style + [fsBold]; … … 1731 1720 LoadPhrases; 1732 1721 LoadFonts; 1733 Templates := LoadGraphicSet 2('Templates.png');1722 Templates := LoadGraphicSet('Templates.png', False); 1734 1723 with Templates do begin 1735 1724 Logo := GetItem('Logo'); … … 1770 1759 1771 1760 HGrSystem := LoadGraphicSet('System.png'); 1772 CityMark1 := HGrSystem.GetItem('CityMark1'); 1773 CityMark2 := HGrSystem.GetItem('CityMark2'); 1761 with HGrSystem do begin 1762 CityMark1 := GetItem('CityMark1'); 1763 CityMark2 := GetItem('CityMark2'); 1764 end; 1774 1765 1775 1766 HGrSystem2 := LoadGraphicSet('System2.png'); 1776 Ornament := HGrSystem2.GetItem('Ornament'); 1767 with HGrSystem2 do begin 1768 Ornament := GetItem('Ornament'); 1769 GBrainNoTerm := GetItem('BrainNoTerm'); 1770 GBrainSuperVirtual := GetItem('BrainSuperVirtual'); 1771 GBrainTerm := GetItem('BrainTerm'); 1772 GBrainRandom := GetItem('BrainRandom'); 1773 end; 1777 1774 1778 1775 Colors := TDpiBitmap.Create;
Note:
See TracChangeset
for help on using the changeset viewer.