Changeset 6 for trunk/LocalPlayer/TechTree.pas
- Timestamp:
- Jan 7, 2017, 11:32:14 AM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LocalPlayer/TechTree.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit TechTree; 4 3 … … 6 5 7 6 uses 8 ScreenTools, Messg,7 ScreenTools, Messg, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 21 20 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 22 21 Shift: TShiftState; X, Y: Integer); 23 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, 24 Y: Integer); 25 procedure FormKeyDown(Sender: TObject; var Key: Word; 26 Shift: TShiftState); 22 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 23 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 27 24 procedure CloseBtnClick(Sender: TObject); 28 25 private 29 xOffset, yOffset, xDown, yDown: integer;26 xOffset, yOffset, xDown, yDown: Integer; 30 27 Image: TBitmap; 31 28 dragging: boolean; … … 43 40 44 41 const 45 BlackBorder=4; 46 LeftBorder=72; RightBorder=45; TopBorder=16; BottomBorder=48; 47 xStart=0; yStart=40; 48 xPitch=160; yPitch=90; 49 xLegend=44; yLegend=79; yLegendPitch=32; 50 51 function min(a,b: integer): integer; 52 begin 53 if a<b then 54 result:=a 55 else result:=b; 56 end; 57 58 function max(a,b: integer): integer; 59 begin 60 if a>b then 61 result:=a 62 else result:=b; 42 BlackBorder = 4; 43 LeftBorder = 72; 44 RightBorder = 45; 45 TopBorder = 16; 46 BottomBorder = 48; 47 xStart = 0; 48 yStart = 40; 49 xPitch = 160; 50 yPitch = 90; 51 xLegend = 44; 52 yLegend = 79; 53 yLegendPitch = 32; 54 55 function min(a, b: Integer): Integer; 56 begin 57 if a < b then 58 result := a 59 else 60 result := b; 61 end; 62 63 function max(a, b: Integer): Integer; 64 begin 65 if a > b then 66 result := a 67 else 68 result := b; 63 69 end; 64 70 65 71 procedure TTechTreeDlg.FormCreate(Sender: TObject); 66 72 begin 67 InitButtons;68 Image:=nil;73 InitButtons; 74 Image := nil; 69 75 end; 70 76 71 77 procedure TTechTreeDlg.FormPaint(Sender: TObject); 72 78 var 73 x,w: integer; 74 begin 75 with Canvas do 76 begin 77 // black border 78 brush.color:=$000000; 79 fillrect(rect(0,0,BlackBorder,ClientHeight)); 80 fillrect(rect(BlackBorder,0,ClientWidth-BlackBorder,BlackBorder)); 81 fillrect(rect(ClientWidth-BlackBorder,0,ClientWidth,ClientHeight)); 82 fillrect(rect(BlackBorder,ClientHeight-BlackBorder,ClientWidth-BlackBorder, 83 ClientHeight)); 84 85 // texturize empty space 86 brush.color:=$FFFFFF; 87 if xOffset>0 then 88 FillRectSeamless(Canvas,BlackBorder,BlackBorder,BlackBorder+xOffset, 89 ClientHeight-BlackBorder,-BlackBorder-xOffset,-BlackBorder-yOffset,Paper); 90 if xOffset+Image.width<ClientWidth-2*BlackBorder then 91 FillRectSeamless(Canvas,BlackBorder+xOffset+Image.width,BlackBorder, 92 ClientWidth-BlackBorder,ClientHeight-BlackBorder,-BlackBorder-xOffset, 93 -BlackBorder-yOffset,Paper); 94 x:=max(BlackBorder,BlackBorder+xOffset); 95 w:=min(BlackBorder+xOffset+Image.width,ClientWidth-BlackBorder); 96 if yOffset>0 then 97 FillRectSeamless(Canvas,x,BlackBorder,w,BlackBorder+yOffset, 98 -BlackBorder-xOffset,-BlackBorder-yOffset,Paper); 99 if yOffset+Image.height<ClientHeight-2*BlackBorder then 100 FillRectSeamless(Canvas,x,BlackBorder+yOffset+Image.height,w, 101 ClientHeight-BlackBorder,-BlackBorder-xOffset,-BlackBorder-yOffset,Paper); 79 X, w: Integer; 80 begin 81 with Canvas do 82 begin 83 // black border 84 brush.color := $000000; 85 fillrect(rect(0, 0, BlackBorder, ClientHeight)); 86 fillrect(rect(BlackBorder, 0, ClientWidth - BlackBorder, BlackBorder)); 87 fillrect(rect(ClientWidth - BlackBorder, 0, ClientWidth, ClientHeight)); 88 fillrect(rect(BlackBorder, ClientHeight - BlackBorder, 89 ClientWidth - BlackBorder, ClientHeight)); 90 91 // texturize empty space 92 brush.color := $FFFFFF; 93 if xOffset > 0 then 94 FillRectSeamless(Canvas, BlackBorder, BlackBorder, BlackBorder + xOffset, 95 ClientHeight - BlackBorder, -BlackBorder - xOffset, 96 -BlackBorder - yOffset, Paper); 97 if xOffset + Image.width < ClientWidth - 2 * BlackBorder then 98 FillRectSeamless(Canvas, BlackBorder + xOffset + Image.width, BlackBorder, 99 ClientWidth - BlackBorder, ClientHeight - BlackBorder, 100 -BlackBorder - xOffset, -BlackBorder - yOffset, Paper); 101 X := max(BlackBorder, BlackBorder + xOffset); 102 w := min(BlackBorder + xOffset + Image.width, ClientWidth - BlackBorder); 103 if yOffset > 0 then 104 FillRectSeamless(Canvas, X, BlackBorder, w, BlackBorder + yOffset, 105 -BlackBorder - xOffset, -BlackBorder - yOffset, Paper); 106 if yOffset + Image.height < ClientHeight - 2 * BlackBorder then 107 FillRectSeamless(Canvas, X, BlackBorder + yOffset + Image.height, w, 108 ClientHeight - BlackBorder, -BlackBorder - xOffset, 109 -BlackBorder - yOffset, Paper); 102 110 end; 103 BitBlt(Canvas.Handle,max(BlackBorder,BlackBorder+xOffset), 104 max(BlackBorder,BlackBorder+yOffset), 105 min(Image.width,min(Image.width+xOffset, 106 min(ClientWidth-2*BlackBorder,ClientWidth-2*BlackBorder-xOffset))), 107 min(Image.Height,min(Image.height+yOffset, 108 min(ClientHeight-2*BlackBorder,ClientHeight-2*BlackBorder-yOffset))), 109 Image.Canvas.Handle,max(0,-xOffset),max(0,-yOffset),SRCCOPY); 111 BitBlt(Canvas.Handle, max(BlackBorder, BlackBorder + xOffset), 112 max(BlackBorder, BlackBorder + yOffset), 113 min(Image.width, min(Image.width + xOffset, 114 min(ClientWidth - 2 * BlackBorder, ClientWidth - 2 * BlackBorder - xOffset)) 115 ), min(Image.height, min(Image.height + yOffset, 116 min(ClientHeight - 2 * BlackBorder, ClientHeight - 2 * BlackBorder - 117 yOffset))), Image.Canvas.Handle, max(0, -xOffset), 118 max(0, -yOffset), SRCCOPY); 110 119 end; 111 120 112 121 procedure TTechTreeDlg.FormShow(Sender: TObject); 113 122 type 114 TLine=array[0..9999,0..2] of Byte;123 TLine = array [0 .. 9999, 0 .. 2] of Byte; 115 124 var 116 x,y,ad,TexWidth,TexHeight: integer;117 s: string;118 SrcLine, DstLine: ^TLine;119 begin 120 if Image=nil then121 begin 122 Image:=TBitmap.Create;123 LoadGraphicFile(Image, HomeDir+'Help\AdvTree',gfNoGamma);124 Image.PixelFormat:=pf24bit;125 126 with Image.Canvas do125 X, Y, ad, TexWidth, TexHeight: Integer; 126 s: string; 127 SrcLine, DstLine: ^TLine; 128 begin 129 if Image = nil then 130 begin 131 Image := TBitmap.Create; 132 LoadGraphicFile(Image, HomeDir + 'Help\AdvTree', gfNoGamma); 133 Image.PixelFormat := pf24bit; 134 135 with Image.Canvas do 127 136 begin 128 // write advance names129 Font.Assign(UniFont[ftSmall]);130 Font.Color:=clBlack;131 Brush.Style:=bsClear;132 for x:=0 to (Image.width-xStart) div xPitch do133 for y:=0 to (Image.height-yStart) div yPitch do137 // write advance names 138 Font.Assign(UniFont[ftSmall]); 139 Font.color := clBlack; 140 brush.Style := bsClear; 141 for X := 0 to (Image.width - xStart) div xPitch do 142 for Y := 0 to (Image.height - yStart) div yPitch do 134 143 begin 135 ad:=Pixels[xStart+x*xPitch+10,yStart+y*yPitch-1];136 if ad and $FFFF00=0 then144 ad := Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1]; 145 if ad and $FFFF00 = 0 then 137 146 begin 138 s:=Phrases.Lookup('ADVANCES',ad); 139 while TextWidth(s)>112 do 140 Delete(s,Length(s),1); 141 TextOut(xStart+x*xPitch+2,yStart+y*yPitch,s); 142 Pixels[xStart+x*xPitch+10,yStart+y*yPitch-1]:=$7F007F; 147 s := Phrases.Lookup('ADVANCES', ad); 148 while TextWidth(s) > 112 do 149 Delete(s, Length(s), 1); 150 TextOut(xStart + X * xPitch + 2, yStart + Y * yPitch, s); 151 Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1] 152 := $7F007F; 143 153 end 144 154 end; 145 155 146 // write legend 147 TextOut(xLegend,yLegend,Phrases2.Lookup('ADVTREE_UP0')); 148 TextOut(xLegend,yLegend+yLegendPitch,Phrases2.Lookup('ADVTREE_UP1')); 149 TextOut(xLegend,yLegend+2*yLegendPitch,Phrases2.Lookup('ADVTREE_UP2')); 150 TextOut(xLegend,yLegend+3*yLegendPitch,Phrases2.Lookup('ADVTREE_GOV')); 151 TextOut(xLegend,yLegend+4*yLegendPitch,Phrases2.Lookup('ADVTREE_OTHER')); 156 // write legend 157 TextOut(xLegend, yLegend, Phrases2.Lookup('ADVTREE_UP0')); 158 TextOut(xLegend, yLegend + yLegendPitch, Phrases2.Lookup('ADVTREE_UP1')); 159 TextOut(xLegend, yLegend + 2 * yLegendPitch, 160 Phrases2.Lookup('ADVTREE_UP2')); 161 TextOut(xLegend, yLegend + 3 * yLegendPitch, 162 Phrases2.Lookup('ADVTREE_GOV')); 163 TextOut(xLegend, yLegend + 4 * yLegendPitch, 164 Phrases2.Lookup('ADVTREE_OTHER')); 152 165 end; 153 166 154 // texturize background155 TexWidth:=Paper.width;156 TexHeight:=Paper.height;157 for y:=0 to Image.height-1 do167 // texturize background 168 TexWidth := Paper.width; 169 TexHeight := Paper.height; 170 for Y := 0 to Image.height - 1 do 158 171 begin 159 SrcLine:=Paper.ScanLine[ymod TexHeight];160 DstLine:=Image.ScanLine[y];161 for x:=0 to Image.Width-1 do172 SrcLine := Paper.ScanLine[Y mod TexHeight]; 173 DstLine := Image.ScanLine[Y]; 174 for X := 0 to Image.width - 1 do 162 175 begin 163 if Cardinal((@DstLine[x])^) and $FFFFFF=$7F007F then // transparent164 DstLine[x]:=SrcLine[xmod TexWidth];176 if Cardinal((@DstLine[X])^) and $FFFFFF = $7F007F then // transparent 177 DstLine[X] := SrcLine[X mod TexWidth]; 165 178 end 166 179 end 167 180 end; 168 181 169 // fit window to image, center image in window, center window to screen 170 Width:=min(Screen.Width-40,Image.Width+LeftBorder+RightBorder+2*BlackBorder); 171 Height:=min(Screen.Height-40,Image.Height+TopBorder+BottomBorder+2*BlackBorder); 172 Left:=(Screen.Width-Width) div 2; 173 Top:=(Screen.Height-Height) div 2; 174 CloseBtn.Left:=Width-CloseBtn.Width-BlackBorder-8; 175 CloseBtn.Top:=BlackBorder+8; 176 xOffset:=(ClientWidth-Image.width+LeftBorder-RightBorder) div 2-BlackBorder; 177 yOffset:=ClientHeight-2*BlackBorder-Image.height-BottomBorder; 182 // fit window to image, center image in window, center window to screen 183 width := min(Screen.width - 40, Image.width + LeftBorder + RightBorder + 2 * 184 BlackBorder); 185 height := min(Screen.height - 40, Image.height + TopBorder + BottomBorder + 2 186 * BlackBorder); 187 Left := (Screen.width - width) div 2; 188 Top := (Screen.height - height) div 2; 189 CloseBtn.Left := width - CloseBtn.width - BlackBorder - 8; 190 CloseBtn.Top := BlackBorder + 8; 191 xOffset := (ClientWidth - Image.width + LeftBorder - RightBorder) div 2 - 192 BlackBorder; 193 yOffset := ClientHeight - 2 * BlackBorder - Image.height - BottomBorder; 178 194 end; 179 195 … … 181 197 Shift: TShiftState; X, Y: Integer); 182 198 begin 183 if Button=mbLeft then184 begin 185 dragging:=true;186 xDown:=x;187 yDown:=y;199 if Button = mbLeft then 200 begin 201 dragging := true; 202 xDown := X; 203 yDown := Y; 188 204 end 189 205 end; … … 192 208 Shift: TShiftState; X, Y: Integer); 193 209 begin 194 dragging:=false;210 dragging := false; 195 211 end; 196 212 … … 198 214 X, Y: Integer); 199 215 begin 200 if dragging then 201 begin 202 xOffset:=xOffset+x-xDown; 203 yOffset:=yOffset+y-yDown; 204 xDown:=x; 205 yDown:=y; 206 207 if xOffset>LeftBorder then 208 xOffset:=LeftBorder; 209 if xOffset<ClientWidth-2*BlackBorder-Image.width-RightBorder then 210 xOffset:=ClientWidth-2*BlackBorder-Image.width-RightBorder; 211 if yOffset>TopBorder then 212 yOffset:=TopBorder; 213 if yOffset<ClientHeight-2*BlackBorder-Image.height-BottomBorder then 214 yOffset:=ClientHeight-2*BlackBorder-Image.height-BottomBorder; 215 216 SmartInvalidate; 216 if dragging then 217 begin 218 xOffset := xOffset + X - xDown; 219 yOffset := yOffset + Y - yDown; 220 xDown := X; 221 yDown := Y; 222 223 if xOffset > LeftBorder then 224 xOffset := LeftBorder; 225 if xOffset < ClientWidth - 2 * BlackBorder - Image.width - RightBorder then 226 xOffset := ClientWidth - 2 * BlackBorder - Image.width - RightBorder; 227 if yOffset > TopBorder then 228 yOffset := TopBorder; 229 if yOffset < ClientHeight - 2 * BlackBorder - Image.height - BottomBorder 230 then 231 yOffset := ClientHeight - 2 * BlackBorder - Image.height - BottomBorder; 232 233 SmartInvalidate; 217 234 end 218 235 end; … … 221 238 Shift: TShiftState); 222 239 begin 223 if key=VK_ESCAPE then224 Close;240 if Key = VK_ESCAPE then 241 Close; 225 242 end; 226 243 227 244 procedure TTechTreeDlg.CloseBtnClick(Sender: TObject); 228 245 begin 229 Close();246 Close(); 230 247 end; 231 248
Note:
See TracChangeset
for help on using the changeset viewer.