Changeset 447 for trunk/Packages
- Timestamp:
- May 19, 2022, 10:39:34 PM (3 years ago)
- Location:
- trunk/Packages
- Files:
-
- 30 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/CevoComponents/AsyncProcess2.pas
r290 r447 122 122 123 123 end. 124 -
trunk/Packages/CevoComponents/BaseWin.pas
r442 r447 23 23 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 24 24 procedure FormDeactivate(Sender: TObject); 25 procedure SmartUpdateContent(ImmUpdate: Boolean = false);25 procedure SmartUpdateContent(ImmUpdate: Boolean = False); 26 26 procedure StayOnTop_Workaround; 27 27 protected … … 50 50 CaptionRight: Integer; 51 51 InnerWidth: Integer; 52 InnerHeight: integer;52 InnerHeight: Integer; 53 53 WideBottom: Boolean; 54 54 FullCaption: Boolean; … … 180 180 UserLeft := Left; 181 181 UserTop := Top; 182 Visible := false;182 Visible := False; 183 183 FWindowMode := NewMode; 184 184 ShowModal; … … 186 186 else if forceclose then 187 187 begin // make modal 188 Visible := false;188 Visible := False; 189 189 FWindowMode := NewMode; 190 190 Left := UserLeft; … … 272 272 procedure TFramedDlg.SmartInvalidate; 273 273 var 274 i, BottomFrame: integer;274 I, BottomFrame: Integer; 275 275 r0, r1: HRgn; 276 276 begin … … 281 281 r0 := CreateRectRgn(SideFrame, TitleHeight, ClientWidth - SideFrame, 282 282 ClientHeight - BottomFrame); 283 for i:= 0 to ControlCount - 1 do284 if not(Controls[ i] is TArea) and Controls[i].Visible then283 for I := 0 to ControlCount - 1 do 284 if not(Controls[I] is TArea) and Controls[I].Visible then 285 285 begin 286 with Controls[ i].BoundsRect do286 with Controls[I].BoundsRect do 287 287 r1 := CreateRectRgn(Left, Top, Right, Bottom); 288 288 CombineRgn(r0, r0, r1, RGN_DIFF); … … 295 295 procedure TFramedDlg.VPaint; 296 296 297 procedure CornerFrame(x0, y0, x1, y1: integer);297 procedure CornerFrame(x0, y0, x1, y1: Integer); 298 298 begin 299 299 Frame(Canvas, x0 + 1, y0 + 1, x1 - 2, y1 - 2, MainTexture.ColorBevelLight, … … 308 308 309 309 var 310 i, l, FrameTop, FrameBottom, InnerBottom, Cut, xTexOffset,311 yTexOffset: integer;310 I, L, FrameTop, FrameBottom, InnerBottom, Cut, xTexOffset, 311 yTexOffset: Integer; 312 312 R: TRect; 313 313 begin … … 321 321 end; 322 322 Canvas.Font.Assign(UniFont[ftCaption]); 323 l:= BiColorTextWidth(Canvas, Caption);324 Cut := (ClientWidth - l) div 2;323 L := BiColorTextWidth(Canvas, Caption); 324 Cut := (ClientWidth - L) div 2; 325 325 xTexOffset := (Maintexture.Width - ClientWidth) div 2; 326 326 yTexOffset := (Maintexture.Height - ClientHeight) div 2; … … 446 446 RisedTextOut(Canvas, Cut - 1, 7, Caption); 447 447 448 for i:= 0 to ControlCount - 1 do449 if Controls[ i].Visible and (Controls[i] is TButtonBase) then448 for I := 0 to ControlCount - 1 do 449 if Controls[I].Visible and (Controls[I] is TButtonBase) then 450 450 begin 451 R := Controls[ i].BoundsRect;451 R := Controls[I].BoundsRect; 452 452 if (R.Bottom <= TitleHeight) or (R.Top >= InnerBottom) then 453 453 BtnFrame(Canvas, R, MainTexture); … … 463 463 begin 464 464 if FullCaption then 465 exit;465 Exit; 466 466 r0 := CreateRectRgn(0, 0, ClientWidth, ClientHeight); 467 467 r1 := CreateRectRgn(0, 0, CaptionLeft, TitleHeight - NarrowFrame); -
trunk/Packages/CevoComponents/ButtonB.pas
r290 r447 11 11 private 12 12 FMask: TBitmap; 13 FIndex: integer;14 procedure SetIndex(Text: integer);13 FIndex: Integer; 14 procedure SetIndex(Text: Integer); 15 15 public 16 16 property Mask: TBitmap read FMask write FMask; 17 17 published 18 18 property Visible; 19 property ButtonIndex: integer read FIndex write SetIndex;19 property ButtonIndex: Integer read FIndex write SetIndex; 20 20 property OnClick; 21 21 protected … … 61 61 end; 62 62 63 procedure TButtonB.SetIndex(Text: integer);63 procedure TButtonB.SetIndex(Text: Integer); 64 64 begin 65 65 if Text <> FIndex then begin -
trunk/Packages/CevoComponents/ButtonBase.pas
r431 r447 15 15 ClickProc: TNotifyEvent; 16 16 DownChangedProc: TNotifyEvent; 17 procedure SetDown( x: boolean);17 procedure SetDown(X: Boolean); 18 18 // procedure PlayDownSound; 19 19 // procedure PlayUpSound; 20 20 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; 21 x, y: integer); override;21 X, Y: Integer); override; 22 22 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; 23 x, y: integer); override;24 procedure MouseMove(Shift: TShiftState; x, y: integer); override;23 X, Y: Integer); override; 24 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 25 25 private 26 Active: boolean;26 Active: Boolean; 27 27 public 28 28 constructor Create(aOwner: TComponent); override; … … 32 32 published 33 33 property Visible; 34 property Down: boolean read FDown write SetDown;35 property Permanent: boolean read FPermanent write FPermanent;34 property Down: Boolean read FDown write SetDown; 35 property Permanent: Boolean read FPermanent write FPermanent; 36 36 property OnClick: TNotifyEvent read ClickProc write ClickProc; 37 37 property OnDownChanged: TNotifyEvent read DownChangedProc … … 50 50 // FUpSound:=''; 51 51 FGraphic := nil; 52 Active := false;53 FDown := false;54 FPermanent := false;52 Active := False; 53 FDown := False; 54 FPermanent := False; 55 55 ClickProc := nil; 56 56 end; 57 57 58 58 procedure TButtonBase.MouseDown(Button: TMouseButton; Shift: TShiftState; 59 x, y: integer);59 X, Y: Integer); 60 60 begin 61 Active := true;62 MouseMove(Shift, x, y);61 Active := True; 62 MouseMove(Shift, X, Y); 63 63 end; 64 64 65 65 procedure TButtonBase.MouseUp(Button: TMouseButton; Shift: TShiftState; 66 x, y: integer);66 X, Y: Integer); 67 67 begin 68 68 if ssLeft in Shift then 69 exit;70 MouseMove(Shift, x, y);69 Exit; 70 MouseMove(Shift, X, Y); 71 71 if Active and FDown then 72 72 begin 73 73 // PlayUpSound; 74 Active := false;74 Active := False; 75 75 if FDown <> FPermanent then 76 76 begin … … 86 86 begin 87 87 // if FDown then PlayUpSound; 88 Active := false;88 Active := False; 89 89 if FDown then 90 90 begin 91 FDown := false;91 FDown := False; 92 92 Invalidate; 93 93 if @DownChangedProc <> nil then … … 97 97 end; 98 98 99 procedure TButtonBase.MouseMove(Shift: TShiftState; x, y: integer);99 procedure TButtonBase.MouseMove(Shift: TShiftState; X, Y: Integer); 100 100 begin 101 101 if Active then 102 if ( x >= 0) and (x < Width) and (y >= 0) and (y< Height) then102 if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then 103 103 if (ssLeft in Shift) and not FDown then 104 104 begin 105 105 { PlayDownSound; } 106 FDown := true;106 FDown := True; 107 107 Paint; 108 108 if @DownChangedProc <> nil then … … 113 113 begin 114 114 { PlayUpSound; } 115 FDown := false;115 FDown := False; 116 116 Paint; 117 117 if @DownChangedProc <> nil then … … 120 120 end; 121 121 122 procedure TButtonBase.SetDown( x: boolean);122 procedure TButtonBase.SetDown(X: Boolean); 123 123 begin 124 FDown := x;124 FDown := X; 125 125 Invalidate; 126 126 end; -
trunk/Packages/CevoComponents/ButtonC.pas
r431 r447 14 14 published 15 15 property Visible; 16 property ButtonIndex: integer read FIndex write SetIndex;16 property ButtonIndex: Integer read FIndex write SetIndex; 17 17 property OnClick; 18 18 protected … … 50 50 end; 51 51 52 procedure TButtonC.SetIndex(Text: integer);52 procedure TButtonC.SetIndex(Text: Integer); 53 53 begin 54 54 if Text <> FIndex then -
trunk/Packages/CevoComponents/ButtonN.pas
r290 r447 10 10 constructor Create(aOwner: TComponent); override; 11 11 private 12 FPossible, FLit: boolean;12 FPossible, FLit: Boolean; 13 13 FGraphic, FMask, FBackGraphic: TBitmap; 14 FIndex, BackIndex: integer;14 FIndex, BackIndex: Integer; 15 15 FSmartHint: string; 16 16 ChangeProc: TNotifyEvent; 17 procedure SetPossible( x: boolean);18 procedure SetLit( x: boolean);19 procedure SetIndex( x: integer);20 procedure SetSmartHint( x: string);17 procedure SetPossible(X: Boolean); 18 procedure SetLit(X: Boolean); 19 procedure SetIndex(X: Integer); 20 procedure SetSmartHint(X: string); 21 21 published 22 property Possible: boolean read FPossible write SetPossible;23 property Lit: boolean read FLit write SetLit;22 property Possible: Boolean read FPossible write SetPossible; 23 property Lit: Boolean read FLit write SetLit; 24 24 property SmartHint: string read FSmartHint write SetSmartHint; 25 25 property Graphic: TBitmap read FGraphic write FGraphic; 26 26 property Mask: TBitmap read FMask write FMask; 27 27 property BackGraphic: TBitmap read FBackGraphic write FBackGraphic; 28 property ButtonIndex: integer read FIndex write SetIndex;28 property ButtonIndex: Integer read FIndex write SetIndex; 29 29 property OnClick: TNotifyEvent read ChangeProc write ChangeProc; 30 30 protected 31 31 procedure Paint; override; 32 32 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; 33 x, y: integer); override;33 X, Y: Integer); override; 34 34 end; 35 35 … … 46 46 begin 47 47 inherited; 48 ShowHint := true;48 ShowHint := True; 49 49 FGraphic := nil; 50 50 FBackGraphic := nil; 51 FPossible := true;52 FLit := false;51 FPossible := True; 52 FLit := False; 53 53 FIndex := -1; 54 54 ChangeProc := nil; … … 63 63 begin 64 64 BitBltCanvas(Canvas, 1, 1, 40, 40, FBackGraphic.Canvas, 65 1 + 80 * BackIndex + 40 * byte(FPossible and FLit), 176);65 1 + 80 * BackIndex + 40 * Byte(FPossible and FLit), 176); 66 66 if FPossible then 67 67 begin … … 83 83 84 84 procedure TButtonN.MouseDown(Button: TMouseButton; Shift: TShiftState; 85 x, y: integer);85 X, Y: Integer); 86 86 begin 87 87 if FPossible and (Button = mbLeft) and (@ChangeProc <> nil) then … … 89 89 end; 90 90 91 procedure TButtonN.SetPossible( x: boolean);91 procedure TButtonN.SetPossible(X: Boolean); 92 92 begin 93 if x<> FPossible then93 if X <> FPossible then 94 94 begin 95 FPossible := x;96 if xthen95 FPossible := X; 96 if X then 97 97 Hint := FSmartHint 98 98 else … … 102 102 end; 103 103 104 procedure TButtonN.SetLit( x: boolean);104 procedure TButtonN.SetLit(X: Boolean); 105 105 begin 106 if x<> FLit then106 if X <> FLit then 107 107 begin 108 FLit := x;108 FLit := X; 109 109 Invalidate; 110 110 end; 111 111 end; 112 112 113 procedure TButtonN.SetIndex( x: integer);113 procedure TButtonN.SetIndex(X: Integer); 114 114 begin 115 if x<> FIndex then115 if X <> FIndex then 116 116 begin 117 FIndex := x;118 if x< 6 then117 FIndex := X; 118 if X < 6 then 119 119 BackIndex := 1 120 120 else … … 124 124 end; 125 125 126 procedure TButtonN.SetSmartHint( x: string);126 procedure TButtonN.SetSmartHint(X: string); 127 127 begin 128 if x<> FSmartHint then128 if X <> FSmartHint then 129 129 begin 130 FSmartHint := x;130 FSmartHint := X; 131 131 if FPossible then 132 Hint := x;132 Hint := X; 133 133 end; 134 134 end; -
trunk/Packages/CevoComponents/CevoComponents.pas
r396 r447 29 29 RegisterPackage('CevoComponents', @Register); 30 30 end. 31 -
trunk/Packages/CevoComponents/Directories.pas
r381 r447 33 33 34 34 if Lang = '' then begin 35 for i:= 1 to Paramcount - 1 do36 if (ParamStrUTF8( i) = '--LANG') or (ParamStrUTF8(i) = '-l') or37 (ParamStrUTF8( i) = '--lang') then38 Lang := ParamStrUTF8( i+ 1);35 for I := 1 to Paramcount - 1 do 36 if (ParamStrUTF8(I) = '--LANG') or (ParamStrUTF8(I) = '-l') or 37 (ParamStrUTF8(I) = '--lang') then 38 Lang := ParamStrUTF8(I + 1); 39 39 end; 40 40 if Lang = '' then begin … … 73 73 (Dst.Time < Src.Time) then 74 74 CopyFile(SourceDir + DirectorySeparator + Src.Name, 75 DestinationDir + DirectorySeparator + Src.Name, false);75 DestinationDir + DirectorySeparator + Src.Name, False); 76 76 FindClose(Dst); 77 77 until FindNext(Src) <> 0; -
trunk/Packages/CevoComponents/DrawDlg.pas
r423 r447 331 331 end. 332 332 333 -
trunk/Packages/CevoComponents/EOTButton.pas
r330 r447 19 19 constructor Create(aOwner: TComponent); override; 20 20 destructor Destroy; override; 21 procedure SetButtonIndexFast( x: integer);22 procedure SetBack(ca: TCanvas; x, y: integer);21 procedure SetButtonIndexFast(X: Integer); 22 procedure SetBack(ca: TCanvas; X, Y: Integer); 23 23 private 24 24 FTemplate: TBitmap; 25 FIndex: integer;26 procedure SetIndex( x: integer);25 FIndex: Integer; 26 procedure SetIndex(X: Integer); 27 27 public 28 28 property Template: TBitmap read FTemplate write FTemplate; 29 29 published 30 30 property Visible; 31 property ButtonIndex: integer read FIndex write SetIndex;31 property ButtonIndex: Integer read FIndex write SetIndex; 32 32 property OnClick; 33 33 protected … … 60 60 Back.SetSize(48, 48); 61 61 Back.Canvas.FillRect(0, 0, Back.Width, Back.Height); 62 ShowHint := true;62 ShowHint := True; 63 63 SetBounds(0, 0, 48, 48); 64 64 end; … … 89 89 end; 90 90 91 procedure TEOTButton.SetIndex( x: integer);91 procedure TEOTButton.SetIndex(X: Integer); 92 92 begin 93 if x<> FIndex then begin94 FIndex := x;93 if X <> FIndex then begin 94 FIndex := X; 95 95 Invalidate; 96 96 end; 97 97 end; 98 98 99 procedure TEOTButton.SetButtonIndexFast( x: integer);99 procedure TEOTButton.SetButtonIndexFast(X: Integer); 100 100 begin 101 if Visible and ( x<> FIndex) then begin102 FIndex := x;101 if Visible and (X <> FIndex) then begin 102 FIndex := X; 103 103 try 104 104 Paint; … … 108 108 end; 109 109 110 procedure TEOTButton.SetBack(ca: TCanvas; x, y: integer);110 procedure TEOTButton.SetBack(ca: TCanvas; X, Y: Integer); 111 111 begin 112 BitBltCanvas(Back.Canvas, 0, 0, 48, 48, ca, x, y);112 BitBltCanvas(Back.Canvas, 0, 0, 48, 48, ca, X, Y); 113 113 end; 114 114 -
trunk/Packages/CevoComponents/ScreenTools.pas
r442 r447 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: TMenuItem; 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: TCanvas; p: TRect; T: TTexture);27 procedure EditFrame(ca: TCanvas; 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(ca: TCanvas; P: TRect; T: TTexture); 27 procedure EditFrame(ca: TCanvas; P: TRect; T: TTexture); 28 function HexStringToColor(S: string): Integer; 29 29 function ExtractFileNameWithoutExt(const Filename: string): string; 30 function LoadGraphicFile(Bmp: TBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): boolean;30 function LoadGraphicFile(Bmp: TBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): Boolean; 31 31 function LoadGraphicSet(const Name: string; Transparency: Boolean = True): TGraphicSet; 32 procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);32 procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 33 33 procedure BitmapReplaceColor(Dst: TBitmap; X, Y, Width, Height: Integer; OldColor, NewColor: TColor); 34 procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);34 procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 35 35 overload; 36 procedure Sprite(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);36 procedure Sprite(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 37 37 overload; 38 38 procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer); … … 45 45 procedure ImageOp_CBC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height, 46 46 Color0, Color2: Integer); 47 procedure ImageOp_CCC(bmp: TBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer);47 procedure ImageOp_CCC(bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer); 48 48 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: Integer; 49 49 SrcCanvas: TCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload; … … 54 54 function BitBltBitmap(Dest: TBitmap; DestRect: TRect; 55 55 Src: TBitmap; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload; 56 procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);57 procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);58 procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);59 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);60 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);56 procedure SLine(ca: TCanvas; x0, x1, Y: Integer; cl: TColor); 57 procedure DLine(ca: TCanvas; x0, x1, Y: Integer; cl0, cl1: TColor); 58 procedure Frame(ca: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor); 59 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor); 60 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: Integer; cl: TColor); 61 61 procedure FrameImage(ca: TCanvas; Src: TBitmap; 62 x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);63 procedure GlowFrame(Dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);62 X, Y, Width, Height, xSrc, ySrc: Integer; IsControl: Boolean = False); 63 procedure GlowFrame(Dst: TBitmap; x0, y0, Width, Height: Integer; cl: TColor); 64 64 procedure InitOrnament; 65 65 procedure InitCityMark(T: TTexture); 66 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer); overload;66 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer); overload; 67 67 procedure Fill(Canvas: TCanvas; Rect: TRect; Offset: TPoint); overload; 68 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);69 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;68 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: Integer); 69 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer; 70 70 const Texture: TBitmap); 71 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;71 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer; 72 72 const Texture: TBitmap); 73 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);74 procedure Corner(ca: TCanvas; x, y, Kind: integer; T: TTexture);75 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer; s: string);73 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer); 74 procedure Corner(ca: TCanvas; X, Y, Kind: Integer; T: TTexture); 75 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; X, Y: Integer; S: string); 76 76 procedure LoweredTextOut(ca: TCanvas; cl: TColor; T: TTexture; 77 x, y: integer; s: string);78 function BiColorTextWidth(ca: TCanvas; s: string): integer;79 procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);80 procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);81 procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);82 procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);83 procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);77 X, Y: Integer; S: string); 78 function BiColorTextWidth(ca: TCanvas; S: string): Integer; 79 procedure RisedTextOut(ca: TCanvas; X, Y: Integer; S: string); 80 procedure LightGradient(ca: TCanvas; X, Y, Width, Color: Integer); 81 procedure DarkGradient(ca: TCanvas; X, Y, Width, Kind: Integer); 82 procedure VLightGradient(ca: TCanvas; X, Y, Height, Color: Integer); 83 procedure VDarkGradient(ca: TCanvas; X, Y, Height, Kind: Integer); 84 84 procedure UnderlinedTitleValue(Canvas: TCanvas; Title, Value: string; X, Y, Width: Integer); 85 procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;85 procedure NumberBar(dst: TBitmap; X, Y: Integer; Cap: string; val: Integer; 86 86 T: TTexture); 87 procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;88 Cap: string; val: integer; T: TTexture);89 procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: integer;87 procedure CountBar(dst: TBitmap; X, Y, W: Integer; Kind: Integer; 88 Cap: string; val: Integer; T: TTexture); 89 procedure PaintProgressBar(ca: TCanvas; Kind, X, Y, Pos, Growth, Max: Integer; 90 90 T: TTexture); 91 91 procedure PaintRelativeProgressBar(ca: TCanvas; 92 Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;92 Kind, X, Y, size, Pos, Growth, Max: Integer; IndicateComplete: Boolean; 93 93 T: TTexture); 94 procedure PaintLogo(Canvas: TCanvas; X, Y, LightColor, ShadeColor: integer);94 procedure PaintLogo(Canvas: TCanvas; X, Y, LightColor, ShadeColor: Integer); 95 95 procedure LoadPhrases; 96 96 procedure Texturize(Dest, Texture: TBitmap; TransparentColor: Cardinal); … … 204 204 {$IFDEF WINDOWS} 205 205 StartResolution: TDeviceMode; 206 ResolutionChanged: boolean;206 ResolutionChanged: Boolean; 207 207 {$ENDIF} 208 208 … … 210 210 211 211 {$IFDEF WINDOWS} 212 function ChangeResolution( x, y, bpp, freq: integer): boolean;212 function ChangeResolution(X, Y, bpp, freq: Integer): Boolean; 213 213 var 214 214 DevMode: TDeviceMode; … … 217 217 DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or 218 218 DM_DISPLAYFREQUENCY; 219 DevMode.dmPelsWidth := x;220 DevMode.dmPelsHeight := y;219 DevMode.dmPelsWidth := X; 220 DevMode.dmPelsHeight := Y; 221 221 DevMode.dmBitsPerPel := bpp; 222 222 DevMode.dmDisplayFrequency := freq; … … 318 318 end; 319 319 320 procedure BtnFrame(ca: TCanvas; p: TRect; T: TTexture);321 begin 322 RFrame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, T.ColorBevelShade,320 procedure BtnFrame(ca: TCanvas; P: TRect; T: TTexture); 321 begin 322 RFrame(ca, P.Left - 1, P.Top - 1, P.Right, P.Bottom, T.ColorBevelShade, 323 323 T.ColorBevelLight); 324 324 end; 325 325 326 procedure EditFrame(ca: TCanvas; p: TRect; T: TTexture);327 begin 328 Frame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, $000000, $000000);329 Frame(ca, p.Left - 2, p.Top - 2, p.Right + 1, p.Bottom + 1, $000000, $000000);330 Frame(ca, p.Left - 3, p.Top - 3, p.Right + 2, p.Bottom + 1, $000000, $000000);331 RFrame(ca, p.Left - 4, p.Top - 4, p.Right + 3, p.Bottom + 2, T.ColorBevelShade,326 procedure EditFrame(ca: TCanvas; P: TRect; T: TTexture); 327 begin 328 Frame(ca, P.Left - 1, P.Top - 1, P.Right, P.Bottom, $000000, $000000); 329 Frame(ca, P.Left - 2, P.Top - 2, P.Right + 1, P.Bottom + 1, $000000, $000000); 330 Frame(ca, P.Left - 3, P.Top - 3, P.Right + 2, P.Bottom + 1, $000000, $000000); 331 RFrame(ca, P.Left - 4, P.Top - 4, P.Right + 3, P.Bottom + 2, T.ColorBevelShade, 332 332 T.ColorBevelLight); 333 333 end; … … 335 335 function HexCharToInt(X: Char): Integer; 336 336 begin 337 case xof337 case X of 338 338 '0' .. '9': Result := Ord(X) - Ord('0'); 339 339 'A' .. 'F': Result := Ord(X) - Ord('A') + 10; … … 492 492 function LoadGraphicSet(const Name: string; Transparency: Boolean = True): TGraphicSet; 493 493 var 494 x: Integer;495 y: Integer;494 X: Integer; 495 Y: Integer; 496 496 OriginalColor: Integer; 497 497 FileName: string; … … 522 522 DataPixel := PixelPointer(Result.Data); 523 523 MaskPixel := PixelPointer(Result.Mask); 524 for y:= 0 to ScaleToNative(Result.Data.Height) - 1 do begin525 for x:= 0 to ScaleToNative(Result.Data.Width) - 1 do begin524 for Y := 0 to ScaleToNative(Result.Data.Height) - 1 do begin 525 for X := 0 to ScaleToNative(Result.Data.Width) - 1 do begin 526 526 OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF; 527 527 if (OriginalColor = TransparentColor1) or (OriginalColor = TransparentColor2) then begin … … 552 552 end; 553 553 554 procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);554 procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 555 555 begin 556 556 BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, … … 650 650 Height := ScaleToNative(dst.Height) - yDst; 651 651 if (Width < 0) or (Height < 0) then 652 exit;652 Exit; 653 653 654 654 dst.BeginUpdate; … … 659 659 for X := 0 to Width - 1 do begin 660 660 Brightness := PixelSrc.Pixel^.B; // One byte for 8-bit color 661 test := (PixelDst.Pixel^.R * Brightness) shr 7;662 if test >= 256 then661 Test := (PixelDst.Pixel^.R * Brightness) shr 7; 662 if Test >= 256 then 663 663 PixelDst.Pixel^.R := 255 664 664 else 665 PixelDst.Pixel^.R := test; // Red666 test := (PixelDst.Pixel^.G * Brightness) shr 7;667 if test >= 256 then665 PixelDst.Pixel^.R := Test; // Red 666 Test := (PixelDst.Pixel^.G * Brightness) shr 7; 667 if Test >= 256 then 668 668 PixelDst.Pixel^.G := 255 669 669 else 670 PixelDst.Pixel^.G := test; // Green671 test := (PixelDst.Pixel^.B * Brightness) shr 7;672 if test >= 256 then670 PixelDst.Pixel^.G := Test; // Green 671 Test := (PixelDst.Pixel^.B * Brightness) shr 7; 672 if Test >= 256 then 673 673 PixelDst.Pixel^.R := 255 674 674 else … … 716 716 Height := ScaleToNative(dst.Height) - yDst; 717 717 if (Width < 0) or (Height < 0) then 718 exit;718 Exit; 719 719 720 720 Src.BeginUpdate; … … 765 765 // R channel = Color2 amp 766 766 var 767 ix, iy, amp0, amp1, trans, Value: integer;767 ix, iy, amp0, amp1, trans, Value: Integer; 768 768 SrcPixel: TPixelPointer; 769 769 DstPixel: TPixelPointer; … … 807 807 end; 808 808 809 procedure ImageOp_CCC(bmp: TBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer);809 procedure ImageOp_CCC(bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer); 810 810 // Bmp is template 811 811 // B channel = Color0 amp, 128=original brightness … … 813 813 // R channel = Color2 amp, 128=original brightness 814 814 var 815 i, Red, Green: Integer;815 I, Red, Green: Integer; 816 816 PixelPtr: TPixelPointer; 817 817 begin … … 821 821 Height := ScaleToNative(Height); 822 822 bmp.BeginUpdate; 823 assert(bmp.PixelFormat = pf24bit);824 Height := y+ Height;825 PixelPtr := PixelPointer(Bmp, x, y);826 while y< Height do begin827 for i:= 0 to Width - 1 do begin823 Assert(bmp.PixelFormat = pf24bit); 824 Height := Y + Height; 825 PixelPtr := PixelPointer(Bmp, X, Y); 826 while Y < Height do begin 827 for I := 0 to Width - 1 do begin 828 828 Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G * 829 829 (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff; … … 838 838 PixelPtr.NextPixel; 839 839 end; 840 Inc( y);840 Inc(Y); 841 841 PixelPtr.NextLine; 842 842 end; … … 844 844 end; 845 845 846 procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);846 procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 847 847 begin 848 848 BitBltCanvas(Canvas, xDst, yDst, Width, Height, … … 852 852 end; 853 853 854 procedure Sprite(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);854 procedure Sprite(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer); 855 855 begin 856 856 BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, … … 890 890 end; 891 891 892 procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);892 procedure SLine(ca: TCanvas; x0, x1, Y: Integer; cl: TColor); 893 893 begin 894 894 with ca do begin 895 895 Pen.Color := cl; 896 MoveTo(x0, y);897 LineTo(x1 + 1, y);898 end; 899 end; 900 901 procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);896 MoveTo(x0, Y); 897 LineTo(x1 + 1, Y); 898 end; 899 end; 900 901 procedure DLine(ca: TCanvas; x0, x1, Y: Integer; cl0, cl1: TColor); 902 902 begin 903 903 with ca do begin 904 904 Pen.Color := cl0; 905 MoveTo(x0, y);906 LineTo(x1, y);905 MoveTo(x0, Y); 906 LineTo(x1, Y); 907 907 Pen.Color := cl1; 908 MoveTo(x0 + 1, y+ 1);909 LineTo(x1 + 1, y+ 1);910 Pixels[x0, y+ 1] := cl0;911 Pixels[x1, y] := cl1;912 end; 913 end; 914 915 procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);908 MoveTo(x0 + 1, Y + 1); 909 LineTo(x1 + 1, Y + 1); 910 Pixels[x0, Y + 1] := cl0; 911 Pixels[x1, Y] := cl1; 912 end; 913 end; 914 915 procedure Frame(ca: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor); 916 916 begin 917 917 with ca do begin … … 926 926 end; 927 927 928 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);928 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: Integer; cl0, cl1: TColor); 929 929 begin 930 930 with ca do begin … … 942 942 end; 943 943 944 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);944 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: Integer; cl: TColor); 945 945 begin 946 946 with ca do begin … … 962 962 963 963 procedure FrameImage(ca: TCanvas; Src: TBitmap; 964 x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);964 X, Y, Width, Height, xSrc, ySrc: Integer; IsControl: Boolean = False); 965 965 begin 966 966 if IsControl then begin 967 Frame(ca, x - 1, y - 1, x + Width, y+ Height, $B0B0B0, $FFFFFF);968 RFrame(ca, x - 2, y - 2, x + Width + 1, y+ Height + 1, $FFFFFF, $B0B0B0);967 Frame(ca, X - 1, Y - 1, X + Width, Y + Height, $B0B0B0, $FFFFFF); 968 RFrame(ca, X - 2, Y - 2, X + Width + 1, Y + Height + 1, $FFFFFF, $B0B0B0); 969 969 end else 970 Frame(ca, x - 1, y - 1, x + Width, y+ Height, $000000, $000000);971 BitBltCanvas(ca, x, y, Width, Height, Src.Canvas, xSrc, ySrc);970 Frame(ca, X - 1, Y - 1, X + Width, Y + Height, $000000, $000000); 971 BitBltCanvas(ca, X, Y, Width, Height, Src.Canvas, xSrc, ySrc); 972 972 end; 973 973 974 974 procedure GlowFrame(Dst: TBitmap; x0, y0, Width, Height: Integer; cl: TColor); 975 975 var 976 x, y, ch, r: Integer;976 X, Y, ch, R: Integer; 977 977 DstPtr: TPixelPointer; 978 978 DpiGlowRange: Integer; … … 985 985 Dst.BeginUpdate; 986 986 DstPtr := PixelPointer(Dst, x0 - DpiGlowRange + 1, y0 - DpiGlowRange + 1); 987 for y:= -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin988 for x:= -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin989 if x< 0 then990 if y< 0 then991 r := round(sqrt(sqr(x) + sqr(y)))992 else if y>= Height then993 r := round(sqrt(sqr(x) + sqr(y- (Height - 1))))987 for Y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin 988 for X := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin 989 if X < 0 then 990 if Y < 0 then 991 R := round(sqrt(sqr(X) + sqr(Y))) 992 else if Y >= Height then 993 R := round(sqrt(sqr(X) + sqr(Y - (Height - 1)))) 994 994 else 995 r := -x996 else if x>= Width then997 if y< 0 then998 r := round(sqrt(sqr(x - (Width - 1)) + sqr(y)))999 else if y>= Height then1000 r := round(sqrt(sqr(x - (Width - 1)) + sqr(y- (Height - 1))))995 R := -X 996 else if X >= Width then 997 if Y < 0 then 998 R := round(sqrt(sqr(X - (Width - 1)) + sqr(Y))) 999 else if Y >= Height then 1000 R := round(sqrt(sqr(X - (Width - 1)) + sqr(Y - (Height - 1)))) 1001 1001 else 1002 r := x- (Width - 1)1003 else if y< 0 then1004 r := -y1005 else if y>= Height then1006 r := y- (Height - 1)1002 R := X - (Width - 1) 1003 else if Y < 0 then 1004 R := -Y 1005 else if Y >= Height then 1006 R := Y - (Height - 1) 1007 1007 else begin 1008 1008 DstPtr.NextPixel; 1009 1009 continue; 1010 1010 end; 1011 if r= 0 then1012 r:= 1;1013 if r< DpiGlowRange then1011 if R = 0 then 1012 R := 1; 1013 if R < DpiGlowRange then 1014 1014 for ch := 0 to 2 do 1015 1015 DstPtr.Pixel^.Planes[2 - ch] := 1016 (DstPtr.Pixel^.Planes[2 - ch] * ( r- 1) + (cl shr (8 * ch) and $FF) *1017 (DpiGlowRange - r)) div (DpiGlowRange - 1);1016 (DstPtr.Pixel^.Planes[2 - ch] * (R - 1) + (cl shr (8 * ch) and $FF) * 1017 (DpiGlowRange - R)) div (DpiGlowRange - 1); 1018 1018 DstPtr.NextPixel; 1019 1019 end; … … 1065 1065 procedure InitCityMark(T: TTexture); 1066 1066 var 1067 x: Integer;1068 y: Integer;1067 X: Integer; 1068 Y: Integer; 1069 1069 Intensity: Integer; 1070 1070 begin 1071 for x:= 0 to CityMark1.Width - 1 do begin1072 for y:= 0 to CityMark1.Height - 1 do begin1073 if HGrSystem.Mask.Canvas.Pixels[CityMark1.Left + x, CityMark1.Top + y] = 0 then1071 for X := 0 to CityMark1.Width - 1 do begin 1072 for Y := 0 to CityMark1.Height - 1 do begin 1073 if HGrSystem.Mask.Canvas.Pixels[CityMark1.Left + X, CityMark1.Top + Y] = 0 then 1074 1074 begin 1075 1075 Intensity := HGrSystem.Data.Canvas.Pixels[CityMark1.Left + 1076 x, CityMark1.Top + y] and $FF;1077 HGrSystem.Data.Canvas.Pixels[CityMark2.Left + x, CityMark2.Top + y] :=1076 X, CityMark1.Top + Y] and $FF; 1077 HGrSystem.Data.Canvas.Pixels[CityMark2.Left + X, CityMark2.Top + Y] := 1078 1078 T.ColorMark and $FF * Intensity div $FF + T.ColorMark shr 8 and 1079 1079 $FF * Intensity div $FF shl 8 + T.ColorMark shr 16 and … … 1103 1103 function Band(I: Integer): Integer; 1104 1104 var 1105 n: integer;1105 N: Integer; 1106 1106 begin 1107 n:= ((MainTexture.Height div 2) div (y1 - y0)) * 2;1107 N := ((MainTexture.Height div 2) div (y1 - y0)) * 2; 1108 1108 while MainTexture.Height div 2 + (I + 1) * (y1 - y0) > MainTexture.Height do 1109 Dec(I, n);1109 Dec(I, N); 1110 1110 while MainTexture.Height div 2 + I * (y1 - y0) < 0 do 1111 Inc(I, n);1111 Inc(I, N); 1112 1112 Result := I; 1113 1113 end; … … 1137 1137 const Texture: TBitmap); 1138 1138 var 1139 x, y, x0cut, y0cut, x1cut, y1cut: Integer;1139 X, Y, x0cut, y0cut, x1cut, y1cut: Integer; 1140 1140 begin 1141 1141 while xOffset < 0 do … … 1143 1143 while yOffset < 0 do 1144 1144 Inc(yOffset, Texture.Height); 1145 for y:= (Top + yOffset) div Texture.Height to (Top + yOffset + Height - 1) div1145 for Y := (Top + yOffset) div Texture.Height to (Top + yOffset + Height - 1) div 1146 1146 Texture.Height do 1147 1147 begin 1148 y0cut := Top + yOffset - y* Texture.Height;1148 y0cut := Top + yOffset - Y * Texture.Height; 1149 1149 if y0cut < 0 then 1150 1150 y0cut := 0; 1151 y1cut := ( y+ 1) * Texture.Height - (Top + yOffset + Height);1151 y1cut := (Y + 1) * Texture.Height - (Top + yOffset + Height); 1152 1152 if y1cut < 0 then 1153 1153 y1cut := 0; 1154 for x:= (Left + xOffset) div Texture.Width to (Left + xOffset + Width - 1) div1154 for X := (Left + xOffset) div Texture.Width to (Left + xOffset + Width - 1) div 1155 1155 Texture.Width do 1156 1156 begin 1157 x0cut := Left + xOffset - x* Texture.Width;1157 x0cut := Left + xOffset - X * Texture.Width; 1158 1158 if x0cut < 0 then 1159 1159 x0cut := 0; 1160 x1cut := ( x+ 1) * Texture.Width - (Left + xOffset + Width);1160 x1cut := (X + 1) * Texture.Width - (Left + xOffset + Width); 1161 1161 if x1cut < 0 then 1162 1162 x1cut := 0; 1163 BitBltCanvas(ca, x* Texture.Width + x0cut - xOffset,1164 y* Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut,1163 BitBltCanvas(ca, X * Texture.Width + x0cut - xOffset, 1164 Y * Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut, 1165 1165 Texture.Height - y0cut - y1cut, Texture.Canvas, x0cut, y0cut); 1166 1166 end; … … 1180 1180 end; 1181 1181 1182 procedure Corner(ca: TCanvas; x, y, Kind: Integer; T: TTexture);1182 procedure Corner(ca: TCanvas; X, Y, Kind: Integer; T: TTexture); 1183 1183 begin 1184 1184 { BitBltCanvas(ca,x,y,8,8,T.HGr.Mask.Canvas, 1185 1185 T.xGr+29+Kind*9,T.yGr+89,SRCAND); 1186 BitBltCanvas(ca, x,y,8,8,T.HGr.Data.Canvas,1186 BitBltCanvas(ca,X,Y,8,8,T.HGr.Data.Canvas, 1187 1187 T.xGr+29+Kind*9,T.yGr+89,SRCPAINT); } 1188 1188 end; 1189 1189 1190 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: Integer; s: string);1191 1192 procedure PaintIcon( x, y, Kind: Integer);1190 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; X, Y: Integer; S: string); 1191 1192 procedure PaintIcon(X, Y, Kind: Integer); 1193 1193 begin 1194 BitBltCanvas(ca, x, y+ 6, 10, 10, HGrSystem.Mask.Canvas,1194 BitBltCanvas(ca, X, Y + 6, 10, 10, HGrSystem.Mask.Canvas, 1195 1195 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND); 1196 BitBltCanvas(ca, x, y+ 6, 10, 10, HGrSystem.Data.Canvas,1196 BitBltCanvas(ca, X, Y + 6, 10, 10, HGrSystem.Data.Canvas, 1197 1197 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT); 1198 1198 end; 1199 1199 1200 1200 var 1201 p, xp: Integer;1201 P, xp: Integer; 1202 1202 sp: string; 1203 1203 shadow: Boolean; 1204 1204 Text: string; 1205 1205 begin 1206 Inc( x);1207 Inc( y);1206 Inc(X); 1207 Inc(Y); 1208 1208 for shadow := True downto False do 1209 1209 with ca do … … 1214 1214 else 1215 1215 Font.Color := clMain; 1216 sp := s;1217 xp := x;1216 sp := S; 1217 xp := X; 1218 1218 repeat 1219 p := pos('%', sp);1220 if ( p = 0) or (p+ 1 > Length(sp)) or not1221 (sp[ p+ 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) then1219 P := Pos('%', sp); 1220 if (P = 0) or (P + 1 > Length(sp)) or not 1221 (sp[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) then 1222 1222 begin 1223 ca.Textout(xp, y, sp);1223 ca.Textout(xp, Y, sp); 1224 1224 Break; 1225 1225 end 1226 1226 else 1227 1227 begin 1228 Text := Copy(sp, 1, p- 1);1229 Textout(xp, y, Text);1228 Text := Copy(sp, 1, P - 1); 1229 Textout(xp, Y, Text); 1230 1230 Inc(xp, ca.TextWidth(Text)); 1231 1231 if not shadow then 1232 case sp[ p+ 1] of1233 'c': PaintIcon(xp + 1, y, 6);1234 'f': PaintIcon(xp + 1, y, 0);1235 'l': PaintIcon(xp + 1, y, 8);1236 'm': PaintIcon(xp + 1, y, 17);1237 'n': PaintIcon(xp + 1, y, 7);1238 'o': PaintIcon(xp + 1, y, 16);1239 'p': PaintIcon(xp + 1, y, 2);1240 'r': PaintIcon(xp + 1, y, 12);1241 't': PaintIcon(xp + 1, y, 4);1242 'w': PaintIcon(xp + 1, y, 13);1232 case sp[P + 1] of 1233 'c': PaintIcon(xp + 1, Y, 6); 1234 'f': PaintIcon(xp + 1, Y, 0); 1235 'l': PaintIcon(xp + 1, Y, 8); 1236 'm': PaintIcon(xp + 1, Y, 17); 1237 'n': PaintIcon(xp + 1, Y, 7); 1238 'o': PaintIcon(xp + 1, Y, 16); 1239 'p': PaintIcon(xp + 1, Y, 2); 1240 'r': PaintIcon(xp + 1, Y, 12); 1241 't': PaintIcon(xp + 1, Y, 4); 1242 'w': PaintIcon(xp + 1, Y, 13); 1243 1243 end; 1244 1244 Inc(xp, 10); 1245 Delete(sp, 1, p+ 1);1245 Delete(sp, 1, P + 1); 1246 1246 end; 1247 1247 until False; 1248 Dec( x);1249 Dec( y);1248 Dec(X); 1249 Dec(Y); 1250 1250 end; 1251 1251 end; 1252 1252 1253 function BiColorTextWidth(ca: TCanvas; s: string): Integer;1253 function BiColorTextWidth(ca: TCanvas; S: string): Integer; 1254 1254 var 1255 1255 P: Integer; … … 1257 1257 Result := 1; 1258 1258 repeat 1259 P := Pos('%', s);1260 if (P = 0) or (P = Length( s)) then1259 P := Pos('%', S); 1260 if (P = 0) or (P = Length(S)) then 1261 1261 begin 1262 Inc(Result, ca.TextWidth( s));1262 Inc(Result, ca.TextWidth(S)); 1263 1263 Break; 1264 1264 end 1265 1265 else 1266 1266 begin 1267 if not ( s[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])1267 if not (S[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) 1268 1268 then 1269 Inc(Result, ca.TextWidth( copy(s, 1, P + 1)))1269 Inc(Result, ca.TextWidth(Copy(S, 1, P + 1))) 1270 1270 else 1271 Inc(Result, ca.TextWidth( copy(s, 1, P - 1)) + 10);1272 Delete( s, 1, P + 1);1271 Inc(Result, ca.TextWidth(Copy(S, 1, P - 1)) + 10); 1272 Delete(S, 1, P + 1); 1273 1273 end; 1274 1274 until False; … … 1276 1276 1277 1277 procedure LoweredTextOut(ca: TCanvas; cl: TColor; T: TTexture; 1278 x, y: Integer; s: string);1278 X, Y: Integer; S: string); 1279 1279 begin 1280 1280 if cl = -2 then 1281 1281 BiColorTextOut(ca, (T.ColorBevelShade and $FEFEFE) shr 1, 1282 T.ColorBevelLight, x, y, s)1282 T.ColorBevelLight, X, Y, S) 1283 1283 else if cl < 0 then 1284 BiColorTextOut(ca, T.ColorTextShade, T.ColorTextLight, x, y, s)1284 BiColorTextOut(ca, T.ColorTextShade, T.ColorTextLight, X, Y, S) 1285 1285 else 1286 BiColorTextOut(ca, cl, T.ColorTextLight, x, y, s);1287 end; 1288 1289 procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);1290 begin 1291 BiColorTextOut(ca, $FFFFFF, $000000, x, y, s);1292 end; 1293 1294 procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: Integer;1295 Brightness: array of integer);1296 var 1297 i, r, g, b: Integer;1298 begin 1299 for i:= 0 to Length(Brightness) - 1 do begin // gradient1300 r := Color and $FF + Brightness[i];1301 if r< 0 then1302 r:= 01303 else if r>= 256 then1304 r:= 255;1305 g := Color shr 8 and $FF + Brightness[i];1306 if g< 0 then1307 g:= 01308 else if g>= 256 then1309 g:= 255;1310 b := Color shr 16 and $FF + Brightness[i];1311 if b< 0 then1312 b:= 01313 else if b>= 256 then1314 b:= 255;1315 ca.Pen.Color := r + g shl 8 + bshl 16;1316 ca.MoveTo( x + dx * i, y + dy * i);1317 ca.LineTo( x + dx * i + Width, y + dy * i+ Height);1286 BiColorTextOut(ca, cl, T.ColorTextLight, X, Y, S); 1287 end; 1288 1289 procedure RisedTextOut(ca: TCanvas; X, Y: Integer; S: string); 1290 begin 1291 BiColorTextOut(ca, $FFFFFF, $000000, X, Y, S); 1292 end; 1293 1294 procedure Gradient(ca: TCanvas; X, Y, dx, dy, Width, Height, Color: Integer; 1295 Brightness: array of Integer); 1296 var 1297 I, R, G, B: Integer; 1298 begin 1299 for I := 0 to Length(Brightness) - 1 do begin // gradient 1300 R := Color and $FF + Brightness[I]; 1301 if R < 0 then 1302 R := 0 1303 else if R >= 256 then 1304 R := 255; 1305 G := Color shr 8 and $FF + Brightness[I]; 1306 if G < 0 then 1307 G := 0 1308 else if G >= 256 then 1309 G := 255; 1310 B := Color shr 16 and $FF + Brightness[I]; 1311 if B < 0 then 1312 B := 0 1313 else if B >= 256 then 1314 B := 255; 1315 ca.Pen.Color := R + G shl 8 + B shl 16; 1316 ca.MoveTo(X + dx * I, Y + dy * I); 1317 ca.LineTo(X + dx * I + Width, Y + dy * I + Height); 1318 1318 end; 1319 1319 ca.Pen.Color := $000000; 1320 ca.MoveTo( x + 1, y+ 16 * dy + Height);1321 ca.LineTo( x + 16 * dx + Width, y+ 16 * dy + Height);1322 ca.LineTo( x + 16 * dx + Width, y);1323 end; 1324 1325 procedure LightGradient(ca: TCanvas; x, y, Width, Color: Integer);1320 ca.MoveTo(X + 1, Y + 16 * dy + Height); 1321 ca.LineTo(X + 16 * dx + Width, Y + 16 * dy + Height); 1322 ca.LineTo(X + 16 * dx + Width, Y); 1323 end; 1324 1325 procedure LightGradient(ca: TCanvas; X, Y, Width, Color: Integer); 1326 1326 const 1327 Brightness: array [0 .. 15] of integer =1327 Brightness: array [0 .. 15] of Integer = 1328 1328 (16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44); 1329 1329 begin 1330 Gradient(ca, x, y, 0, 1, Width, 0, Color, Brightness);1331 end; 1332 1333 procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: Integer);1330 Gradient(ca, X, Y, 0, 1, Width, 0, Color, Brightness); 1331 end; 1332 1333 procedure DarkGradient(ca: TCanvas; X, Y, Width, Kind: Integer); 1334 1334 const 1335 Brightness: array [0 .. 15] of integer =1335 Brightness: array [0 .. 15] of Integer = 1336 1336 (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44); 1337 1337 begin 1338 Gradient(ca, x, y, 0, 1, Width, 0, HGrSystem.Data.Canvas.Pixels1338 Gradient(ca, X, Y, 0, 1, Width, 0, HGrSystem.Data.Canvas.Pixels 1339 1339 [187, 137 + Kind], Brightness); 1340 1340 end; 1341 1341 1342 procedure VLightGradient(ca: TCanvas; x, y, Height, Color: Integer);1342 procedure VLightGradient(ca: TCanvas; X, Y, Height, Color: Integer); 1343 1343 const 1344 Brightness: array [0 .. 15] of integer =1344 Brightness: array [0 .. 15] of Integer = 1345 1345 (16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44); 1346 1346 begin 1347 Gradient(ca, x, y, 1, 0, 0, Height, Color, Brightness);1348 end; 1349 1350 procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: Integer);1347 Gradient(ca, X, Y, 1, 0, 0, Height, Color, Brightness); 1348 end; 1349 1350 procedure VDarkGradient(ca: TCanvas; X, Y, Height, Kind: Integer); 1351 1351 const 1352 Brightness: array [0 .. 15] of integer =1352 Brightness: array [0 .. 15] of Integer = 1353 1353 (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44); 1354 1354 begin 1355 Gradient(ca, x, y, 1, 0, 0, Height,1355 Gradient(ca, X, Y, 1, 0, 0, Height, 1356 1356 HGrSystem.Data.Canvas.Pixels[187, 137 + Kind], Brightness); 1357 1357 end; … … 1364 1364 end; 1365 1365 1366 procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string;1366 procedure NumberBar(dst: TBitmap; X, Y: Integer; Cap: string; 1367 1367 val: Integer; T: TTexture); 1368 1368 var 1369 s: string;1369 S: string; 1370 1370 begin 1371 1371 if val > 0 then 1372 1372 begin 1373 DLine(dst.Canvas, x - 2, x + 170, y+ 16, T.ColorBevelShade,1373 DLine(dst.Canvas, X - 2, X + 170, Y + 16, T.ColorBevelShade, 1374 1374 T.ColorBevelLight); 1375 LoweredTextOut(dst.Canvas, -1, T, x - 2, y, Cap);1376 s:= IntToStr(val);1377 RisedTextOut(dst.Canvas, x+ 170 - BiColorTextWidth(dst.Canvas,1378 s), y, s);1379 end; 1380 end; 1381 1382 procedure CountBar(dst: TBitmap; x, y, w: Integer; Kind: Integer;1375 LoweredTextOut(dst.Canvas, -1, T, X - 2, Y, Cap); 1376 S := IntToStr(val); 1377 RisedTextOut(dst.Canvas, X + 170 - BiColorTextWidth(dst.Canvas, 1378 S), Y, S); 1379 end; 1380 end; 1381 1382 procedure CountBar(dst: TBitmap; X, Y, W: Integer; Kind: Integer; 1383 1383 Cap: string; val: Integer; T: TTexture); 1384 1384 var 1385 i, sd, ld, cl, xIcon, yIcon: Integer;1386 s: string;1385 I, sd, ld, cl, xIcon, yIcon: Integer; 1386 S: string; 1387 1387 begin 1388 1388 // val:=random(40); //!!! … … 1396 1396 // DLine(dst.Canvas,x-2,x+170+32,y+16,T.ColorBevelShade,T.ColorBevelLight); 1397 1397 1398 xIcon := x- 5;1399 yIcon := y+ 15;1400 DLine(dst.Canvas, x - 2, xIcon + w+ 2, yIcon + 16, T.ColorBevelShade,1398 xIcon := X - 5; 1399 yIcon := Y + 15; 1400 DLine(dst.Canvas, X - 2, xIcon + W + 2, yIcon + 16, T.ColorBevelShade, 1401 1401 T.ColorBevelLight); 1402 1402 1403 s:= IntToStr(val);1403 S := IntToStr(val); 1404 1404 if val < 0 then 1405 1405 cl := $0000FF 1406 1406 else 1407 1407 cl := -1; 1408 LoweredTextOut(dst.Canvas, cl, T, x - 2, y, Cap);1408 LoweredTextOut(dst.Canvas, cl, T, X - 2, Y, Cap); 1409 1409 LoweredTextOut(dst.Canvas, cl, T, 1410 xIcon + w + 2 - BiColorTextWidth(dst.Canvas, s), yIcon, s);1410 xIcon + W + 2 - BiColorTextWidth(dst.Canvas, S), yIcon, S); 1411 1411 1412 1412 if (Kind = 12) and (val >= 100) then … … 1416 1416 if sd = 0 then 1417 1417 sd := 1; 1418 if sd < w- 44 then1418 if sd < W - 44 then 1419 1419 ld := sd 1420 1420 else 1421 ld := w- 44;1422 for i:= 0 to val mod 10 - 1 do1421 ld := W - 44; 1422 for I := 0 to val mod 10 - 1 do 1423 1423 begin 1424 BitBltCanvas(dst.Canvas, xIcon + 4 + i* (14 * ld div sd), yIcon + 2 + 1, 14,1424 BitBltCanvas(dst.Canvas, xIcon + 4 + I * (14 * ld div sd), yIcon + 2 + 1, 14, 1425 1425 14, HGrSystem.Mask.Canvas, 67 + Kind mod 8 * 15, 1426 1426 70 + Kind div 8 * 15, SRCAND); 1427 Sprite(dst, HGrSystem, xIcon + 3 + i* (14 * ld div sd), yIcon + 2,1427 Sprite(dst, HGrSystem, xIcon + 3 + I * (14 * ld div sd), yIcon + 2, 1428 1428 14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15); 1429 1429 end; 1430 for i:= 0 to val div 10 - 1 do1430 for I := 0 to val div 10 - 1 do 1431 1431 begin 1432 1432 BitBltCanvas(dst.Canvas, xIcon + 4 + (val mod 10) * 1433 (14 * ld div sd) + i* (14 * ld div sd), yIcon + 3, 14, 14,1433 (14 * ld div sd) + I * (14 * ld div sd), yIcon + 3, 14, 14, 1434 1434 HGrSystem.Mask.Canvas, 67 + 7 mod 8 * 15, 1435 1435 70 + 7 div 8 * 15, SRCAND); 1436 1436 Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) * 1437 (14 * ld div sd) + i* (14 * ld div sd), yIcon + 2, 14,1437 (14 * ld div sd) + I * (14 * ld div sd), yIcon + 2, 14, 1438 1438 14, 67 + 7 mod 8 * 15, 1439 1439 70 + 7 div 8 * 15); … … 1449 1449 if sd = 0 then 1450 1450 sd := 1; 1451 if sd < w- 44 then1451 if sd < W - 44 then 1452 1452 ld := sd 1453 1453 else 1454 ld := w- 44;1455 for i:= 0 to val div 10 - 1 do1454 ld := W - 44; 1455 for I := 0 to val div 10 - 1 do 1456 1456 begin 1457 BitBltCanvas(dst.Canvas, xIcon + 4 + i* (14 * ld div sd), yIcon + 3, 14, 14,1457 BitBltCanvas(dst.Canvas, xIcon + 4 + I * (14 * ld div sd), yIcon + 3, 14, 14, 1458 1458 HGrSystem.Mask.Canvas, 67 + Kind mod 8 * 15, 1459 1459 70 + Kind div 8 * 15, SRCAND); 1460 Sprite(dst, HGrSystem, xIcon + 3 + i* (14 * ld div sd), yIcon + 2,1460 Sprite(dst, HGrSystem, xIcon + 3 + I * (14 * ld div sd), yIcon + 2, 1461 1461 14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15); 1462 1462 end; 1463 for i:= 0 to val mod 10 - 1 do1463 for I := 0 to val mod 10 - 1 do 1464 1464 begin 1465 1465 BitBltCanvas(dst.Canvas, xIcon + 4 + (val div 10) * 1466 (14 * ld div sd) + i* (10 * ld div sd), yIcon + 7, 10, 10,1466 (14 * ld div sd) + I * (10 * ld div sd), yIcon + 7, 10, 10, 1467 1467 HGrSystem.Mask.Canvas, 66 + Kind mod 11 * 11, 1468 1468 115 + Kind div 11 * 11, SRCAND); 1469 1469 Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) * 1470 (14 * ld div sd) + i* (10 * ld div sd), yIcon + 6, 10,1470 (14 * ld div sd) + I * (10 * ld div sd), yIcon + 6, 10, 1471 1471 10, 66 + Kind mod 11 * 11, 1472 1472 115 + Kind div 11 * 11); … … 1476 1476 end; 1477 1477 1478 procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: Integer;1478 procedure PaintProgressBar(ca: TCanvas; Kind, X, Y, Pos, Growth, Max: Integer; 1479 1479 T: TTexture); 1480 1480 var 1481 i: Integer;1482 begin 1483 if pos > max then1484 pos := max;1481 I: Integer; 1482 begin 1483 if Pos > Max then 1484 Pos := Max; 1485 1485 if Growth < 0 then 1486 1486 begin 1487 pos := pos + Growth;1488 if pos < 0 then1487 Pos := Pos + Growth; 1488 if Pos < 0 then 1489 1489 begin 1490 Growth := Growth - pos;1491 pos := 0;1490 Growth := Growth - Pos; 1491 Pos := 0; 1492 1492 end; 1493 1493 end 1494 else if pos + Growth > max then1495 Growth := max - pos;1496 Frame(ca, x - 1, y - 1, x + max, y+ 7, $000000, $000000);1497 RFrame(ca, x - 2, y - 2, x + max + 1, y+ 8, T.ColorBevelShade,1494 else if Pos + Growth > Max then 1495 Growth := Max - Pos; 1496 Frame(ca, X - 1, Y - 1, X + Max, Y + 7, $000000, $000000); 1497 RFrame(ca, X - 2, Y - 2, X + Max + 1, Y + 8, T.ColorBevelShade, 1498 1498 T.ColorBevelLight); 1499 1499 with ca do 1500 1500 begin 1501 for i := 0 to pos div 8 - 1 do1502 BitBltCanvas(ca, x + i * 8, y, 8, 7,1501 for I := 0 to Pos div 8 - 1 do 1502 BitBltCanvas(ca, X + I * 8, Y, 8, 7, 1503 1503 HGrSystem.Data.Canvas, 104, 9 + 8 * Kind); 1504 BitBltCanvas(ca, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,1504 BitBltCanvas(ca, X + 8 * (Pos div 8), Y, Pos - 8 * (Pos div 8), 7, 1505 1505 HGrSystem.Data.Canvas, 104, 9 + 8 * Kind); 1506 1506 if Growth > 0 then 1507 1507 begin 1508 for i:= 0 to Growth div 8 - 1 do1509 BitBltCanvas(ca, x + pos + i * 8, y, 8, 7,1508 for I := 0 to Growth div 8 - 1 do 1509 BitBltCanvas(ca, X + Pos + I * 8, Y, 8, 7, 1510 1510 HGrSystem.Data.Canvas, 112, 9 + 8 * Kind); 1511 BitBltCanvas(ca, x + pos + 8 * (Growth div 8), y,1511 BitBltCanvas(ca, X + Pos + 8 * (Growth div 8), Y, 1512 1512 Growth - 8 * (Growth div 8), 7, HGrSystem.Data.Canvas, 1513 1513 112, 9 + 8 * Kind); … … 1515 1515 else if Growth < 0 then 1516 1516 begin 1517 for i:= 0 to -Growth div 8 - 1 do1518 BitBltCanvas(ca, x + pos + i * 8, y, 8, 7,1517 for I := 0 to -Growth div 8 - 1 do 1518 BitBltCanvas(ca, X + Pos + I * 8, Y, 8, 7, 1519 1519 HGrSystem.Data.Canvas, 104, 1); 1520 BitBltCanvas(ca, x + pos + 8 * (-Growth div 8), y, -Growth -1520 BitBltCanvas(ca, X + Pos + 8 * (-Growth div 8), Y, -Growth - 1521 1521 8 * (-Growth div 8), 7, 1522 1522 HGrSystem.Data.Canvas, 104, 1); 1523 1523 end; 1524 1524 Brush.Color := $000000; 1525 FillRect(Rect( x + pos + abs(Growth), y, x + max, y+ 7));1525 FillRect(Rect(X + Pos + abs(Growth), Y, X + Max, Y + 7)); 1526 1526 Brush.Style := bsClear; 1527 1527 end; … … 1530 1530 // pos and growth are relative to max, set size independent 1531 1531 procedure PaintRelativeProgressBar(ca: TCanvas; 1532 Kind, x, y, size, pos, Growth, max: Integer; IndicateComplete: Boolean;1532 Kind, X, Y, size, Pos, Growth, Max: Integer; IndicateComplete: Boolean; 1533 1533 T: TTexture); 1534 1534 begin 1535 1535 if Growth > 0 then 1536 PaintProgressBar(ca, Kind, x, y, pos * size div max,1537 (Growth * size + max div 2) div max, size, T)1536 PaintProgressBar(ca, Kind, X, Y, Pos * size div Max, 1537 (Growth * size + Max div 2) div Max, size, T) 1538 1538 else 1539 PaintProgressBar(ca, Kind, x, y, pos * size div max,1540 (Growth * size - max div 2) div max, size, T);1541 if IndicateComplete and ( pos + Growth >= max) then1542 Sprite(ca, HGrSystem, x + size - 10, y- 7, 23, 16, 1, 129);1539 PaintProgressBar(ca, Kind, X, Y, Pos * size div Max, 1540 (Growth * size - Max div 2) div Max, size, T); 1541 if IndicateComplete and (Pos + Growth >= Max) then 1542 Sprite(ca, HGrSystem, X + size - 10, Y - 7, 23, 16, 1, 129); 1543 1543 end; 1544 1544 … … 1610 1610 procedure DarkenImage(Bitmap: TBitmap; Change: Integer); 1611 1611 var 1612 x, y: integer;1612 X, Y: Integer; 1613 1613 PicturePixel: TPixelPointer; 1614 1614 begin 1615 1615 Bitmap.BeginUpdate; 1616 1616 PicturePixel := PixelPointer(Bitmap); 1617 for y:= 0 to ScaleToNative(Bitmap.Height) - 1 do begin1618 for x:= 0 to ScaleToNative(Bitmap.Width) - 1 do begin1617 for Y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin 1618 for X := 0 to ScaleToNative(Bitmap.Width) - 1 do begin 1619 1619 PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0); 1620 1620 PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0); … … 1662 1662 Section: TFontType; 1663 1663 FontScript: TextFile; 1664 Size: integer;1664 Size: Integer; 1665 1665 S: string; 1666 I: integer;1667 P: integer;1666 I: Integer; 1667 P: Integer; 1668 1668 begin 1669 1669 Section := ftNormal; … … 1672 1672 Reset(FontScript); 1673 1673 while not Eof(FontScript) do begin 1674 ReadLn(FontScript, s);1675 if s<> '' then1676 if s[1] = '#' then begin1677 s := TrimRight(s);1678 if s= '#SMALL' then Section := ftSmall1679 else if s= '#TINY' then Section := ftTiny1680 else if s= '#CAPTION' then Section := ftCaption1681 else if s= '#BUTTON' then Section := ftButton1674 ReadLn(FontScript, S); 1675 if S <> '' then 1676 if S[1] = '#' then begin 1677 S := TrimRight(S); 1678 if S = '#SMALL' then Section := ftSmall 1679 else if S = '#TINY' then Section := ftTiny 1680 else if S = '#CAPTION' then Section := ftCaption 1681 else if S = '#BUTTON' then Section := ftButton 1682 1682 else Section := ftNormal; 1683 1683 end else begin 1684 p := Pos(',', s);1685 if p> 0 then begin1686 UniFont[section].Name := Trim(Copy( s, 1, p- 1));1684 P := Pos(',', S); 1685 if P > 0 then begin 1686 UniFont[section].Name := Trim(Copy(S, 1, P - 1)); 1687 1687 Size := 0; 1688 for i := p + 1 to Length(s) do1689 case s[i] of1688 for I := P + 1 to Length(S) do 1689 case S[I] of 1690 1690 '0' .. '9': 1691 Size := Size * 10 + Byte( s[i]) - 48;1691 Size := Size * 10 + Byte(S[I]) - 48; 1692 1692 'B', 'b': 1693 1693 UniFont[section].Style := UniFont[section].Style + [fsBold]; -
trunk/Packages/CevoComponents/Sound.pas
r424 r447 280 280 begin 281 281 Result := 0; 282 while (Result < SoundList.Count) and (SoundList[ result].FFileName <> FileName) do282 while (Result < SoundList.Count) and (SoundList[Result].FFileName <> FileName) do 283 283 Inc(Result); 284 284 if Result = SoundList.Count then begin -
trunk/Packages/CevoComponents/StringTables.pas
r300 r447 16 16 constructor Create; 17 17 destructor Destroy; override; 18 function LoadFromFile(const FileName: String): boolean;19 function GetHandle(const Item: string): integer;20 function LookupByHandle(Handle: integer; Index: integer = -1): string;18 function LoadFromFile(const FileName: String): Boolean; 19 function GetHandle(const Item: string): Integer; 20 function LookupByHandle(Handle: Integer; Index: Integer = -1): string; 21 21 function Lookup(const Item: string; Index: Integer = -1): string; 22 function Search(const Content: string; var Handle, Index: integer): boolean;22 function Search(const Content: string; var Handle, Index: Integer): Boolean; 23 23 end; 24 24 … … 45 45 end; 46 46 47 function TStringTable.LoadFromFile(const FileName: String): boolean;47 function TStringTable.LoadFromFile(const FileName: String): Boolean; 48 48 begin 49 49 Result := True; … … 56 56 end; 57 57 58 function TStringTable.GetHandle(const Item: string): integer;58 function TStringTable.GetHandle(const Item: string): Integer; 59 59 var 60 60 I: Integer; … … 67 67 end; 68 68 69 function TStringTable.LookupByHandle(Handle: integer; Index: integer): string;69 function TStringTable.LookupByHandle(Handle: Integer; Index: Integer): string; 70 70 var 71 s: string;71 S: string; 72 72 begin 73 73 if Index < 0 then begin … … 77 77 end else begin 78 78 if Pos(' ', Lines[Handle]) = 0 then S := '' 79 else s:= Copy(Lines[Handle], Pos(' ', Lines[Handle]) + 1, MaxInt);79 else S := Copy(Lines[Handle], Pos(' ', Lines[Handle]) + 1, MaxInt); 80 80 while ((Handle + 1) < Lines.Count) and (Copy(Lines[Handle + 1], 1, 1) <> '#') do begin 81 81 Inc(Handle); 82 82 if (Length(Lines[Handle]) > 0) and (Lines[Handle][1] <> '''') then begin 83 if ( s <> '') and (s[Length(s)] <> '\') then84 s := s+ ' ';85 s := s+ Lines[Handle];83 if (S <> '') and (S[Length(S)] <> '\') then 84 S := S + ' '; 85 S := S + Lines[Handle]; 86 86 end; 87 87 end; … … 116 116 { might become necessary for 1.3 117 117 118 function TStringTable.Lookup(const Fallback: TStringTable; const Item: string; Index: integer): string;118 function TStringTable.Lookup(const Fallback: TStringTable; const Item: string; Index: Integer): string; 119 119 var 120 Handle: integer;120 Handle: Integer; 121 121 begin 122 122 Handle:=Gethandle(Item); 123 if Handle>=0 then result:=LookupByHandle(Handle, Index)124 else result:='';125 if result='' then126 result:=Fallback.Lookup(Item, Index);123 if Handle>=0 then Result:=LookupByHandle(Handle, Index) 124 else Result:=''; 125 if Result='' then 126 Result:=Fallback.Lookup(Item, Index); 127 127 end; 128 128 129 function TStringTable.TryLookup(const Item: string; Index: integer): string;129 function TStringTable.TryLookup(const Item: string; Index: Integer): string; 130 130 var 131 Handle: integer;131 Handle: Integer; 132 132 begin 133 133 Handle:=Gethandle(Item); 134 if Handle>=0 then result:=LookupByHandle(Handle, Index)135 else result:='';134 if Handle>=0 then Result:=LookupByHandle(Handle, Index) 135 else Result:=''; 136 136 end; } 137 137 138 138 function TStringTable.Search(const Content: string; 139 var Handle, Index: integer): boolean;139 var Handle, Index: Integer): Boolean; 140 140 var 141 h, i: integer;141 H, I: Integer; 142 142 UContent: string; 143 143 begin 144 144 UContent := UpperCase(Content); 145 h:= Handle;146 if h< 0 then147 i:= 0145 H := Handle; 146 if H < 0 then 147 I := 0 148 148 else 149 i:= Index + 1;149 I := Index + 1; 150 150 repeat 151 if h + i+ 1 >= Lines.Count then151 if H + I + 1 >= Lines.Count then 152 152 begin 153 result := false;154 exit;153 Result := False; 154 Exit; 155 155 end; 156 if Copy(Lines[ h + i+ 1], 1, 1) = '#' then156 if Copy(Lines[H + I + 1], 1, 1) = '#' then 157 157 begin 158 h := h + i+ 1;159 i:= -1;158 H := H + I + 1; 159 I := -1; 160 160 end; 161 if ( h >= 0) and not ((Length(Lines[h + i + 1]) > 0) and (Lines[h + i+ 1][1] in ['#', ':', ';'])) and162 (Pos(UContent, UpperCase(Lines[ h + i+ 1])) > 0) then161 if (H >= 0) and not ((Length(Lines[H + I + 1]) > 0) and (Lines[H + I + 1][1] in ['#', ':', ';'])) and 162 (Pos(UContent, UpperCase(Lines[H + I + 1])) > 0) then 163 163 begin 164 Index := i;165 Handle := h;164 Index := I; 165 Handle := H; 166 166 Result := True; 167 167 Exit; -
trunk/Packages/CevoComponents/UGraphicSet.pas
r424 r447 272 272 end. 273 273 274 -
trunk/Packages/CevoComponents/UTexture.pas
r380 r447 97 97 end. 98 98 99 -
trunk/Packages/Common/Common.pas
r396 r447 37 37 RegisterPackage('Common', @Register); 38 38 end. 39 -
trunk/Packages/Common/StopWatch.pas
r424 r447 35 35 implementation 36 36 37 constructor TStopWatch.Create(const startOnCreate : boolean = false) ;37 constructor TStopWatch.Create(const startOnCreate : Boolean = False) ; 38 38 begin 39 39 inherited Create; … … 72 72 begin 73 73 dt := ElapsedMiliseconds / MSecsPerSec / SecsPerDay; 74 result := Format('%d days, %s', [Trunc(dt), FormatDateTime('hh:nn:ss.z', Frac(dt))]) ;74 Result := Format('%d days, %s', [Trunc(dt), FormatDateTime('hh:nn:ss.z', Frac(dt))]) ; 75 75 end; 76 76 … … 93 93 94 94 end. 95 -
trunk/Packages/Common/UAboutDialog.pas
r424 r447 51 51 end. 52 52 53 -
trunk/Packages/Common/UCommon.pas
r424 r447 42 42 clLightRed = TColor($8080FF); 43 43 44 function AddLeadingZeroes(const aNumber, Length : integer) : string;44 function AddLeadingZeroes(const aNumber, Length : Integer) : string; 45 45 function BinToInt(BinStr: string): Int64; 46 46 function BinToHexString(Source: AnsiString): string; … … 96 96 function BinToInt(BinStr : string) : Int64; 97 97 var 98 i : byte;98 I : Byte; 99 99 RetVar : Int64; 100 100 begin 101 101 BinStr := UpperCase(BinStr); 102 if BinStr[ length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);102 if BinStr[Length(BinStr)] = 'B' then Delete(BinStr,Length(BinStr),1); 103 103 RetVar := 0; 104 for i := 1 to length(BinStr) do begin105 if not (BinStr[ i] in ['0','1']) then begin104 for I := 1 to Length(BinStr) do begin 105 if not (BinStr[I] in ['0','1']) then begin 106 106 RetVar := 0; 107 107 Break; 108 108 end; 109 RetVar := (RetVar shl 1) + ( byte(BinStr[i]) and 1) ;109 RetVar := (RetVar shl 1) + (Byte(BinStr[I]) and 1) ; 110 110 end; 111 111 … … 435 435 end; 436 436 437 function AddLeadingZeroes(const aNumber, Length : integer) : string;437 function AddLeadingZeroes(const aNumber, Length : Integer) : string; 438 438 begin 439 439 Result := SysUtils.Format('%.*d', [Length, aNumber]) ; … … 614 614 begin 615 615 for J := ReadFrom to Len do 616 if (S[ j] = C) then616 if (S[J] = C) then 617 617 begin 618 618 Result := J; … … 631 631 Inc(I); 632 632 APos := ReadUntil(I, '<'); 633 Result := Result + Copy(S, I, APos - i);633 Result := Result + Copy(S, I, APos - I); 634 634 I := ReadUntil(APos + 1, '>'); 635 635 end; -
trunk/Packages/Common/UFindFile.pas
r424 r447 6 6 Tired of using FindFirst, Next and Close? 7 7 Come see how to encapsulate all those functions 8 in a single "find-files-recursively" component.8 in A Single "find-files-recursively" component. 9 9 It's easy to use, free and with code. 10 10 … … 34 34 TFindFile = class(TComponent) 35 35 private 36 s: TStringList;37 fSubFolder : boolean;36 S : TStringList; 37 fSubFolder : Boolean; 38 38 fAttr: TFileAttrib; 39 39 fPath : string; … … 47 47 published 48 48 property FileAttr: TFileAttrib read fAttr write fAttr; 49 property InSubFolders : boolean read fSubFolder write fSubFolder;49 property InSubFolders : Boolean read fSubFolder write fSubFolder; 50 50 property Path : string read fPath write SetPath; 51 51 property FileMask : string read fFileMask write fFileMask ; … … 79 79 FileMask := FilterAll; 80 80 FileAttr := [ffaAnyFile]; 81 s:= TStringList.Create;81 S := TStringList.Create; 82 82 end; 83 83 84 84 destructor TFindFile.Destroy; 85 85 begin 86 s.Free;86 S.Free; 87 87 inherited Destroy; 88 88 end; … … 101 101 function TFindFile.SearchForFiles: TStringList; 102 102 begin 103 s.Clear;103 S.Clear; 104 104 try 105 105 FileSearch(Path); 106 106 finally 107 Result := s;107 Result := S; 108 108 end; 109 109 end; … … 111 111 procedure TFindFile.FileSearch(const InPath : string); 112 112 var Rec : TSearchRec; 113 Attr : integer;113 Attr : Integer; 114 114 begin 115 115 Attr := 0; … … 125 125 try 126 126 repeat 127 s.Add(inPath + Rec.Name);127 S.Add(inPath + Rec.Name); 128 128 until SysUtils.FindNext(Rec) <> 0; 129 129 finally -
trunk/Packages/Common/UFormAbout.pas
r423 r447 83 83 end. 84 84 85 -
trunk/Packages/Common/UGeometric.pas
r424 r447 52 52 function PointToLineDistance(const P, V, W: TPoint): Integer; 53 53 var 54 l2, t: Double;54 l2, T: Double; 55 55 tt: TPoint; 56 56 begin … … 165 165 end. 166 166 167 -
trunk/Packages/Common/UJobProgressView.pas
r424 r447 221 221 for I := 0 to ListViewJobs.Items.Count - 1 do 222 222 begin 223 ItemRect := ListViewJobs.Items[ i].DisplayRect(drBounds);223 ItemRect := ListViewJobs.Items[I].DisplayRect(drBounds); 224 224 Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top)); 225 225 end; -
trunk/Packages/Common/UMetaCanvas.pas
r424 r447 124 124 procedure SetWidth(AValue: Integer); override; 125 125 function GetWidth: Integer; override; 126 procedure DoLine (x1,y1,x2,y2: integer); override;126 procedure DoLine (x1,y1,x2,y2:Integer); override; 127 127 procedure DoTextOut(X, Y: Integer; Text: string); override; 128 128 procedure DoRectangle(const Bounds: TRect); override; … … 451 451 end; 452 452 453 procedure TMetaCanvas.DoLine(x1, y1, x2, y2: integer);453 procedure TMetaCanvas.DoLine(x1, y1, x2, y2: Integer); 454 454 var 455 455 NewObj: TCanvasLine; … … 665 665 end. 666 666 667 -
trunk/Packages/Common/UPrefixMultiplier.pas
r423 r447 30 30 BasePrefixMultipliers: TPrefixMultiplierDef = 31 31 ( 32 (ShortText: 'y'; FullText: 'yocto'; Value: 1 e-24),33 (ShortText: 'z'; FullText: 'zepto'; Value: 1 e-21),34 (ShortText: 'a'; FullText: 'atto'; Value: 1 e-18),35 (ShortText: 'f'; FullText: 'femto'; Value: 1 e-15),36 (ShortText: 'p'; FullText: 'piko'; Value: 1 e-12),37 (ShortText: 'n'; FullText: 'nano'; Value: 1 e-9),38 (ShortText: 'u'; FullText: 'mikro'; Value: 1 e-6),39 (ShortText: 'm'; FullText: 'mili'; Value: 1 e-3),32 (ShortText: 'y'; FullText: 'yocto'; Value: 1E-24), 33 (ShortText: 'z'; FullText: 'zepto'; Value: 1E-21), 34 (ShortText: 'a'; FullText: 'atto'; Value: 1E-18), 35 (ShortText: 'f'; FullText: 'femto'; Value: 1E-15), 36 (ShortText: 'p'; FullText: 'piko'; Value: 1E-12), 37 (ShortText: 'n'; FullText: 'nano'; Value: 1E-9), 38 (ShortText: 'u'; FullText: 'mikro'; Value: 1E-6), 39 (ShortText: 'm'; FullText: 'mili'; Value: 1E-3), 40 40 (ShortText: ''; FullText: ''; Value: 1e0), 41 41 (ShortText: 'k'; FullText: 'kilo'; Value: 1e3), … … 51 51 TimePrefixMultipliers: TPrefixMultiplierDef = 52 52 ( 53 (ShortText: 'ys'; FullText: 'yocto'; Value: 1 e-24),54 (ShortText: 'zs'; FullText: 'zepto'; Value: 1 e-21),55 (ShortText: 'as'; FullText: 'atto'; Value: 1 e-18),56 (ShortText: 'fs'; FullText: 'femto'; Value: 1 e-15),57 (ShortText: 'ps'; FullText: 'piko'; Value: 1 e-12),58 (ShortText: 'ns'; FullText: 'nano'; Value: 1 e-9),59 (ShortText: 'us'; FullText: 'mikro'; Value: 1 e-6),60 (ShortText: 'ms'; FullText: 'mili'; Value: 1 e-3),53 (ShortText: 'ys'; FullText: 'yocto'; Value: 1E-24), 54 (ShortText: 'zs'; FullText: 'zepto'; Value: 1E-21), 55 (ShortText: 'as'; FullText: 'atto'; Value: 1E-18), 56 (ShortText: 'fs'; FullText: 'femto'; Value: 1E-15), 57 (ShortText: 'ps'; FullText: 'piko'; Value: 1E-12), 58 (ShortText: 'ns'; FullText: 'nano'; Value: 1E-9), 59 (ShortText: 'us'; FullText: 'mikro'; Value: 1E-6), 60 (ShortText: 'ms'; FullText: 'mili'; Value: 1E-3), 61 61 (ShortText: 's'; FullText: 'sekunda'; Value: 1), 62 62 (ShortText: 'min'; FullText: 'minuta'; Value: 60), -
trunk/Packages/Common/UResetableThread.pas
r423 r447 296 296 end. 297 297 298 -
trunk/Packages/Common/UScaleDPI.pas
r424 r447 259 259 begin 260 260 ImgList.Add(Temp[I], nil); 261 Temp[ i].Free;261 Temp[I].Free; 262 262 end; 263 263 finally -
trunk/Packages/Common/UStringTable.pas
r424 r447 39 39 function TStringTable.GetColCount: Integer; 40 40 begin 41 Result := Size. x;41 Result := Size.X; 42 42 end; 43 43 -
trunk/Packages/Common/UTheme.pas
r424 r447 188 188 189 189 end. 190 -
trunk/Packages/Common/UTranslator.pas
r424 r447 420 420 421 421 if Lang = '' then begin 422 for i:= 1 to Paramcount - 1 do423 if (ParamStr( i) = '--LANG') or (ParamStr(i) = '-l') or424 (ParamStr( i) = '--lang') then425 Lang := ParamStr( i+ 1);422 for I := 1 to Paramcount - 1 do 423 if (ParamStr(I) = '--LANG') or (ParamStr(I) = '-l') or 424 (ParamStr(I) = '--lang') then 425 Lang := ParamStr(I + 1); 426 426 end; 427 427 if Lang = '' then begin … … 473 473 DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 474 474 if FileExistsUTF8(Result) then 475 exit;475 Exit; 476 476 477 477 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator + LangID + 478 478 DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 479 479 if FileExistsUTF8(Result) then 480 exit;480 Exit; 481 481 482 482 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator 483 483 + LangID + DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 484 484 if FileExistsUTF8(Result) then 485 exit;485 Exit; 486 486 487 487 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator … … 489 489 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 490 490 if FileExistsUTF8(Result) then 491 exit;491 Exit; 492 492 493 493 {$IFDEF UNIX} … … 496 496 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 497 497 if FileExistsUTF8(Result) then 498 exit;498 Exit; 499 499 {$ENDIF} 500 500 // Let us search for reducted files 501 LangShortID := copy(LangID, 1, 2);501 LangShortID := Copy(LangID, 1, 2); 502 502 // At first, check all was checked 503 503 Result := ExtractFilePath(ParamStrUTF8(0)) + LangShortID + 504 504 DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 505 505 if FileExistsUTF8(Result) then 506 exit;506 Exit; 507 507 508 508 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator + … … 510 510 ExtractFileName(ParamStrUTF8(0)), LCExt); 511 511 if FileExistsUTF8(Result) then 512 exit;512 Exit; 513 513 514 514 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator … … 516 516 ExtractFileName(ParamStrUTF8(0)), LCExt); 517 517 if FileExistsUTF8(Result) then 518 exit;518 Exit; 519 519 520 520 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator … … 522 522 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 523 523 if FileExistsUTF8(Result) then 524 exit;524 Exit; 525 525 526 526 // Full language in file name - this will be default for the project … … 529 529 Result := ExtractFilePath(ParamStrUTF8(0)) + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangID])) + LCExt; 530 530 if FileExistsUTF8(Result) then 531 exit;531 Exit; 532 532 // Common location (like in Lazarus) 533 533 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator + 534 534 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangID])) + LCExt; 535 535 if FileExistsUTF8(Result) then 536 exit;536 Exit; 537 537 538 538 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + 539 539 DirectorySeparator + ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangID])) + LCExt; 540 540 if FileExistsUTF8(Result) then 541 exit;541 Exit; 542 542 except 543 543 Result := ''; // Or do something else (useless) … … 548 548 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), LCExt); 549 549 if FileExistsUTF8(Result) then 550 exit;550 Exit; 551 551 {$ENDIF} 552 552 Result := ExtractFilePath(ParamStrUTF8(0)) + ChangeFileExt( 553 553 ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangShortID])) + LCExt; 554 554 if FileExistsUTF8(Result) then 555 exit;555 Exit; 556 556 557 557 Result := ExtractFilePath(ParamStrUTF8(0)) + 'locale' + DirectorySeparator + 558 558 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangShortID])) + LCExt; 559 559 if FileExistsUTF8(Result) then 560 exit;560 Exit; 561 561 562 562 Result := ExtractFilePath(ParamStrUTF8(0)) + 'languages' + DirectorySeparator + 563 563 ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), Format(FormatLang, [LangShortID])) + LCExt; 564 564 if FileExistsUTF8(Result) then 565 exit;565 Exit; 566 566 end; 567 567
Note:
See TracChangeset
for help on using the changeset viewer.