Version:0.9 StartHTML:0000000105 EndHTML:0000060555 StartFragment:0000001037 EndFragment:0000060539
program BitmapGame3_Load_Solution_BITMAX;
// Game: PascalPicturePuzzle - P3 Deluxe Version
// Loads several sliced bitmaps with an aggregation from TPicture Class at array of TBitmap
// A function stretches and rectangels also a bitmap with specified number of pixels
// in horizontal, vertical dimension, locs=518 , intf= 23
// adapted from the book software praxis delphi of thomas strauss, improved by max
Type
TField2 = array[0..5] of String;
TField1 = array[0..5] of TField2;
TDir2 = array[1..2] of smallint;
Const FBOX = 4;
QB = FBOX*FBOX;
GPIC = 'examples\max_locomotion.bmp';
var
frmMon: TForm;
Image1: TImage;
drG: TDrawGrid;
frmsg: TStringGrid;
stat: TStatusbar;
panstep: TPanel;
Progress: TProgressBar;
picname: shortstring;
Zug: integer;
Field, zField: TField1; //Feldbelegung, Zielfeld
bArr: Array[1..QB+1] of TBitmap;
dir: array[1..FBOX] of TDir2;
procedure initNavArray;
begin
dir[1][1]:= 0;
dir[1][2]:= -1;
dir[2][1]:= 1;
dir[2][2]:= 0;
dir[3][1]:= 0;
dir[3][2]:= 1;
dir[4][1]:= -1;
dir[4][2]:= 0;
(*=(( 0,-1), //N
( 1, 0), //O
( 0, 1), //S
(-1, 0) //W *)
end;
procedure CloseClick(Sender: TObject; var action: TCloseAction); forward;
procedure loadImage;
var aRect: TRect;
bm: TBitMap;
begin
bm:= TBitMap.Create;
try
//bm.LoadFromFile(ExePath+'examples\citymax.bmp');
//picname:= ExePath+'examples\citymax.bmp'; //maxboxfrac.bmp
picname:= ExePath+GPIC;
bm.LoadFromFile(picname);
//Image1.Picture.BitMap.LoadFromFile();
aRect:= Rect(0,0,image1.Width,image1.Height);
image1.Canvas.StretchDraw(aRect, bm);
finally
bm.Free;
end;
end;
procedure OpenPicture(var img: TImage);
var bm: TBitMap; aRect: TRect;
begin
bm:= TBitMap.Create;
with TOpenDialog.Create(self) do begin
Filter:= 'bitmap files (*.bmp)|*.BMP';
InitialDir:= ExtractFilePath(Application.ExeName);
if Execute then begin
try
bm.LoadFromFile(FileName);
picname:= Filename;
except
showmessageBig('This is not a valid -------- BMP Picture!');
end;
end;
end;
//Scale Bitmap bm at size of img1
aRect:=Rect(0,0,image1.Width,image1.Height);
image1.Canvas.StretchDraw(aRect, bm);
bm.Free;
end;
procedure MakePuzzlePeaces;
//Erstellen der Teilquadrate und speichern in bArr
var
i,bhg,bh,z,s,z1,s1,z2,s2: integer;
r1,r2: TRect;
begin
bhg:= image1.Picture.Width;
bh:= bhg div FBOX;
for i:= 1 to QB do begin //Größe der Images einstellen!
bArr[i].Width:= bh;
bArr[i].Height:= bh;
end;
//Images erstellen durch Kopieren aus dem Quellbild
for i:= 1 to QB do begin
//Zeile/Spalte des Rasters bestimmen
z:=(i-1) div FBOX + 1; s:=(i-1) mod FBOX + 1;
s1:=(s-1)*bh; z1:=(z-1)*bh;
s2:=s*bh; z2:=z*bh;
//Quadrate unter Berücksichtigung der Ränder definieren
r1:=Rect(s1+1,z1+1,s2-1,z2-1); //Source
r2:=Rect(1,1,bh-1,bh-1); //Destination
with bArr[i].Canvas do begin
Pen.Color:= RGB2TColor(100,100,100);
Rectangle(0,0,bh,bh);
CopyRect(r2,image1.Canvas,r1);
end;
end;
//letztes Quadrat weißen //bArr[17]:= bArr[16]; //save last
bArr[QB].Canvas.Brush.Color:= clWhite;
bArr[QB].Canvas.FillRect(Rect(1,1,bh-1,bh-1));
end;
procedure FinishedField;
//erzeugt die Zielbelegung auf zField
var w,z,s: smallint;
begin
for z:= 0 to 5 do //Spielfeld löschen
for s:= 0 to 5 do
zField[s][z]:= '#'; //Randbelegung
w:= 0;
for z:= 1 to FBOX do
for s:= 1 to FBOX do begin
inc(w);
zField[s][z]:= IntToStr(w);
end;
zField[FBOX][FBOX]:= ' ';
end;
procedure HideGridCursor(g: TStringGrid);
//Cursor aus dem StringGrid entfernen
var gr: TRect;//TGridRect;
begin
with gr do begin
Top:=-1; Left:=-1; Right:=-1; Bottom:=-1
end; //g.Selection:= gr;
end;
procedure DrawField(f: TField1);
var
z,s: integer;
begin
for z:=1 to FBOX do
for s:=1 to FBOX do begin
frmsg.Cells[s-1,z-1]:= f[s][z];
end;
//Form1.panZug.Caption:=IntToStr(Zug);
HideGridCursor(frmsg);
end;
function GetFreeDir(x,y: integer): integer;
//ermittelt die freie Richtung und gibt zurück:
//0...kein Nachbar frei; 1-4 für N/O/S/W
var
d,fd: integer;
begin
fd:= 0;
for d:= 1 to FBOX do begin //check all directions
if Field[x+dir[d][1]][y+dir[d][2]]=' ' then fd:= d;
end;
result:= fd;
end;
function HasFinished: boolean;
var
finished: boolean;
z,s: integer;
begin
finished:=true;
for z:=1 to FBOX do
for s:=1 to FBOX do
if Field[s][z]<>zField[s][z] then finished:= false;
result:= finished;
end;
function RandomField: TField1;
var
f0: TField1;
f,f1: Array[1..QB] of string;
free: Array[1..QB] of boolean;
i,z,s,w: integer;
begin
Randomize;
for i:=1 to QB-1 do f[i]:= IntToStr(i);
f[16]:=' ';
for i:=1 to QB do free[i]:= true;
w:=0;
repeat //Zufallsbelegung in Linearfeld
repeat
z:= Random(QB)+1;
until free[z];
inc(w);
f1[w]:= f[z];
free[z]:= false;
until w=QB;
w:= 0;
for z:=1 to FBOX do //take it
for s:= 1 to FBOX do begin
inc(w);
f0[s][z]:=f1[w];
end;
Result:= f0;
end;
function maxSteps: integer;
//liefert die Anzahl der Entfernungs-Schritte zur Zielkonstellation
//mit der größtmöglichen Unordnung auf dem Feld
var z,s,sum: integer;
begin
sum:=0;
for z:=1 to 4 do
for s:=1 to 4 do
sum:=sum + max(z-1,4-z)+ max(s-1,4-s);
result:= sum;
end;
function Steps(f: TField1): integer;
//liefert Schritte zur Zielkonstellation
//aus der aktuellen Belegung von f
var
s,z,x,y,w1,sum: integer;
t: string;
begin
sum:= 0;
for z:=1 to 4 do begin
for s:=1 to 4 do begin
t:=f[s][z];
if t=' ' then
w1:= 16 else //Zahl auf dem Feld
w1:= StrToInt(t);
x:= round(abs((((w1-1) mod 4)+1)-s));
y:= round(abs((((w1-1) div 4)+1)-z)); //Zielposition
sum:= sum+x+y;
end;
end;
result:= sum;
end;
//*********************** event handlers *********************************//
procedure btnNewPicClick(Sender: TObject);
begin
//OpenPicture(img1); loadimage
stat.SimpleText:= 'Welcome to PicPuzzle: '+ExtractFileName(picname)+' is loaded';
drG.Visible:=false;
MakePuzzlePeaces;
FinishedField;
Field:=zField;
DrawField(zField);
drG.Visible:=True;
//btnNewGame.Enabled:=True;
//btnCancel.Enabled:=True;
end;
procedure btnPictureLoad(Sender: TObject);
begin
OpenPicture(image1);
btnNewPicClick(Self);
end;
procedure btnNewGameClick(Sender: TObject);
var p: real;
begin
Field:=zField;
Progress.Max:= maxSteps+20;
Field:= zField;
Field:= RandomField;
Zug:= 0;
p:= 100-Steps(Field)/MaxSteps*100;
panStep.Caption:= formatFloat('0',p)+' %';
Progress.Position:= round(p);
drG.Repaint;
DrawField(Field);
HideGridCursor(frmsg);
stat.SimpleText:='Game is running ...';
//stat.Color:=$30809000;
//btnNewPic.Enabled:=false;
end;
procedure btnCloseClick(Sender: TObject);
begin
stat.SimpleText:= 'Closed Clicked';
frmMon.Close;
end;
procedure CloseClick(Sender: TObject; var action: TCloseAction);
var i: integer;
begin
//if MessageDlg('Wanna Leave?',mtConfirmation,[mbYes, mbNo],0)= mrYes then begin
//form1.Free; //bmp.Free;
for i:= 1 to QB+1 do bArr[i].Free;
action:= caFree;
writeln('Free and Closer test finished');
//end else
//Action:= caNone;
end;
Function RGB(R,G,B: Byte): TColor;
Begin
Result:= B Shl 16 Or G Shl 8 Or R;
End;
procedure drGClick(Sender: TObject); //next step
var x,y,x1,y1,d: integer;
p: single;
w: String;
begin
x:= drG.Col+1;
y:= drG.Row+1;
d:= GetFreeDir(x,y);
if d>0 then begin //free neigbour cell
x1:=x+dir[d][1];
y1:=y+dir[d][2];
w:= Field[x][y];
Field[x][y]:= Field[x1][y1];
Field[x1][y1]:= w;
inc(Zug);
p:= 100-Steps(Field)/MaxSteps*100;
//writeln('debug '+floattostr(p)+' '+floattostr(steps(field)) );
panStep.Caption:= 'Step: ' +inttoStr(zug)+' '+formatFloat('0',p)+' %';
Progress.Position:= round(p);
DrawField(Field);
drG.Repaint;
end;
if HasFinished then begin
writeln('You won - End of picture game');
stat.SimpleText:= 'PicturePuzzle Solved';
//bArr[16].Canvas.Brush.color:= clred;
end;
end;
procedure drGDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var nr: integer; t: string;
begin
with Sender {as TDrawGrid} do begin
t:= Field[ACol+1][ARow+1];
if t=' ' then nr:= QB else nr:= StrToInt(t);
drg.Canvas.Draw(Rect.Left, Rect.Top, bArr[nr]);
end;
end;
//*************************Form Create********************************//
procedure InitCreateForms;
var i: smallint;
panImg, panR: TPanel;
begin
// seq --> panel-image-drawgrid-bitmap
for i:= 1 to QB+1 do bArr[i]:= TBitMap.Create;
HideGridCursor(frmsg);
//panimg1.DoubleBuffered:= true;
frmMon:= TForm.Create(self);
with frmMon do begin
//FormStyle := fsStayOnTop;
Position:= poScreenCenter;
BorderIcons:= [biSystemMenu, biMinimize];
BorderStyle:= bsSingle;
PixelsPerInch:= 96;
caption:='PascalPicturePuzzle of BITMAX';
color:= clred;
width:= 650;
height:= 540;
Show;
onClose:= @CloseClick;
end;
panImg:= TPanel.Create(frmMon)
with panImg do begin
parent:= frmMon;
setBounds(8,8,451, 451)
BevelOuter:= bvLowered
//DoubleBuffered:= true;
end;
Image1:= TImage.create(frmMon);
with Image1 do begin
parent:= panImg;
setbounds(1,1, 450,450);
//show;
end;
drG:= TDrawGrid.Create(frmMon);
with drG do begin
parent:= panImg;
Left:= 0; Top:= 0;
Width:= 455; Height:= 455;
Cursor:= crHandPoint;
ColCount:= 4;
DefaultColWidth:= 111;
DefaultRowHeight:= 111
FixedCols:= 0;
RowCount:= 4;
FixedRows:= 0;
Options:= [goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine];
ScrollBars:= ssNone;
Visible:= False;
OnClick:= @drGClick;
OnDrawCell:= @drGDrawCell;
end;
PanR:= TPanel.create(frmMon);
with PanR do begin
parent:= frmMon;
setBounds(472,9,155,450);
BevelOuter:= bvLowered
TabOrder:= 1
end;
with TBitBtn.Create(frmMon) do begin
Parent:= frmMon;
SetBounds(488,196,121,30)
Caption:= 'Load Picture'
Hint:= 'Load your own bitmap picture!';
ShowHint:= true;
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPEJECT');
OnClick:= @BtnPictureLoad;
end;
with TBitBtn.Create(frmMon) do begin
Parent:= frmMon;
SetBounds(488,234,121,30)
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTEP');
Caption:= 'New Game'
//Enabled:= False
//TabOrder = 7
OnClick:= @btnNewGameClick
end;
with TBitBtn.Create(frmMon) do begin
Parent:= frmMon;
SetBounds(488,420,121,30)
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTOP');
Caption:= 'Close'
OnClick:= @btnCloseClick
end;
with TLabel.Create(frmMon) do begin
Parent:= PanR;
SetBounds(18,110,50,18)
Caption:= 'Progress:'
end;
with TLabel.Create(frmMon) do begin
Parent:= PanR;
SetBounds(18,167,50,18)
Caption:= 'Games:'
end;
with TLabel.Create(frmMon) do begin
Parent:= PanR;
SetBounds(18,290,50,18)
Caption:= 'Navigation:'
end;
panstep:= TPanel.Create(frmMon);
with panstep do begin
Parent:= frmMon;
SetBounds(488,138,121,22)
BevelOuter:= bvLowered
Caption:= '0 %'
Color:= clyellow;//$30809000;
//Color:= 8404992
end;
frmsg:= TStringGrid.Create(frmMon);
with frmsg do begin
//SetBounds(512,320,79,79)
parent:= frmMon;
Left:= 512; Top:= 320;
Width:= 79; Height:= 79;
ColCount:= 4
DefaultColWidth:= 18
DefaultRowHeight:= 18
FixedCols:= 0
RowCount:= 4
FixedRows:= 0
end;
with TJvAnalogClock.Create(frmMon) do begin
parent:= PanR;
bevelwidth:= 0;
colormin:= clblue;
//timeoffSet:= -120;
//align:= alclient;
ColorHr:= clRed;
//WidthHandHr:= 1;
ColorHandHr:= clRed;
ColorHandMin:= clRed;
setBounds(28,5,100,100);
//centercol:= cldarkblue32; //clwebgold;
centersize:= 4;
end;
stat:= TStatusbar.Create(FrmMon);
with Stat do begin
parent:= frmMon;
stat.SimplePanel:= true;
end;
Progress:= TProgressBar.Create(frmMon);
with progress do begin
parent:= frmMon;
Align:= alBottom;
TabOrder:= 2;
//step:= 10;
Max:= maxSteps+20;
end;
end;
///////////////// Main App ////////////////
begin
InitNavArray;
InitCreateForms;
//LoadBitMap; //test
loadImage; //default
btnNewPicClick(Self);
PrintF('DiskSize: %d DiskFree: %d',[disksize(3) div 1024
, diskfree(3) div 1024]);
End.
/////////////////Text Mode
Windows-8-Bedienung scheitert im iX-Praxistest
Meldung vorlesen und MP3-Download
Anlässlich der kontroversen Diskussion über das Windows-8-GUI wollte iX es wissen: Was ist dran an der
Fundamentalkritik, wie sie etwa kürzlich vom Webdesignexperten Jakob Nielsen zu hören war? Vier prototypische
Anwender sollten mit dem neuen System ihre alltäglichen Aufgaben erledigen. Ihr ernüchterndes Fazit: Keiner sah in
Windows 8 einen Vorteil oder einen Fortschritt, weder Einsteiger noch ambitionierte Nutzer, professionelle Anwender
oder Administratoren. Alle beklagten, dass die Arbeitsschritte umständlich seien. Die Bedienelemente der neuen
Oberfläche fanden sie eher zufällig, an einen besten Weg erinnerten sie sich anschließend nicht. Zum Schluss
blieb überwiegend Frustration und Verwirrung übrig.
Vor allem das erzwungene Wechseln zwischen Desktop und Kacheln fanden alle umständlich. Auch die neue Startansicht
konnte nicht überzeugen, sie stellte nach Meinung der Tester keinen adäquaten Ersatz für das fehlende Startmenü dar.
Von der viel gepriesenen und durchaus hilfreichen Windows-Taste – auf Tablets und Hybrid-Systemen der einzige Button
in Display-Nähe – etwa machte keiner der Anwender Gebrauch. Auch die neue Suche, die bereitwillig erscheint, wenn
man auf der neuen Startansicht einfach auf der Tastatur lostippt, blieb unangetastet. Immerhin: Innerhalb der
klassischen Windows-Anwendungen funktionierte das Arbeiten wie gewohnt.
Zwar ist ein Test mit vier Probanden kein repräsentativer Versuch. Aber die Ergebnisse passen zu gut in die weithin geäußerte Kritik, um sie als zufällig abtun zu können. Administratoren sollten, so das Artikelfazit, sich auf einen erheblichen Schulungsaufwand für ihre Anwender einstellen,
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var i: byte;
begin
//test function
Image1.Canvas.MoveTo(X,Y);
image1.canvas.pen.color:= clyellow;
image1.canvas.penpos;
for i:= 1 to 30 do
//Image1.Canvas.LineTo(X+random(140),Y+random(140));
Image1.Picture.Bitmap.Canvas.LineTo(X+random(140),Y+random(140));
end;