pascal 造图像
pascal吧
全部回复
仅看楼主
level 3
I_evol 楼主
我想做一个填字游戏 但不知道可不可以再pascal中造出图中的图

2015年01月04日 08点01分 1
level 3
I_evol 楼主
求大神指教[乖]
2015年01月04日 08点01分 2
level 3
I_evol 楼主
我顶
2015年01月04日 10点01分 3
level 9
你是想生成图片吗?
还是想生成一个GUI 图形用户的界面?
2015年01月04日 12点01分 4
5楼图
2015年01月04日 12点01分
level 3
I_evol 楼主
2015年01月04日 12点01分 5
看图片的文件格式,用二进制写出文件
2015年01月04日 12点01分
回复 I_evol :你是想在程序中显示出图形,还是生成一张一张的图片game.bmp这样子
2015年01月04日 13点01分
回复 I_evol :我打算做一个填字游戏
2015年01月04日 13点01分
level 9
可以。
2015年01月04日 12点01分 6
求大神指教[开心]
2015年01月04日 12点01分
level 9
{$APPTYPE GUI}
{$MODE DELPHI}
program WinPiece;
uses
Windows;
const
AppName = 'draw'; //app的名字
pm = 30; //方块大小
top =20; //top离顶距离
left =20;//left:离左距离
var
dc : hdc;
AMessage : Msg;
hWindow: HWnd;
//map代表格子,0是白色,1是黑色
Map : array[0..9,0..9] of 0..1=(
(0,0,0,1,0,1,0,1,0,1),
(1,1,0,0,0,1,0,0,0,0),
(0,0,0,1,1,0,1,0,1,1),
(0,1,1,0,0,0,1,0,1,0),
(0,0,0,0,1,0,0,0,0,0),
(0,1,1,0,1,0,1,1,1,0),
(0,1,0,1,0,0,0,0,0,1),
(0,0,0,0,1,0,1,1,0,0),
(0,1,0,1,0,0,0,1,0,1),
(1,0,0,0,1,1,1,0,0,0)
);
{ 画出图形 }
procedure DrawMap();
var
i,j: integer;
begin
SelectObject (dc, GetStockObject (BLACK_PEN)) ; //选择黑色画笔
for i:=0 to 9 do
begin
for j:= 0 to 9 do
begin
if Map[i,j]=1 then
SelectObject (dc, GetStockObject (BLACK_BRUSH)) //选择黑色笔 刷,就是内部填充的颜色
else
SelectObject (dc, GetStockObject (WHITE_BRUSH)); ////选择白色笔 刷
Rectangle(dc,left+j*pm,top+i*pm,left+j*pm+pm,top+i*pm+pm);//画出一个矩形
end;
end;
end;
function WindowProc(Window: HWnd; AMessage: UINT; WParam : WPARAM;
LParam: LPARAM): LRESULT; stdcall; export;
begin
WindowProc := 0;
case AMessage of
wm_paint:
begin
DefWindowProc(Window, AMessage, WParam, LParam);
dc:= GetDC(window);
DrawMap();
ReleaseDC(window, dc) ;
end;
wm_Destroy:
begin
PostQuitMessage(0);
Exit;
end;
end;
WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;
{ Register the Window Class }
function WinRegister: Boolean;
var
WindowClass: WndClass;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := WndProc(@WindowProc);
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := system.MainInstance;
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := AppName;
WinRegister := RegisterClass(WindowClass) <> 0;
end;
{ Create the Window Class }
function WinCreate: HWnd;
begin
hWindow := CreateWindow(AppName, '填图游戏',
ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
340, 360, 0, 0, system.MainInstance, nil);
if hWindow <> 0 then
begin
ShowWindow(hWindow, CmdShow);
ShowWindow(hWindow, SW_SHOW);
UpdateWindow(hWindow);
end;
WinCreate := hWindow;
end;
{ begin }
begin
if not WinRegister then
begin
MessageBox(0, 'Register failed', nil, mb_Ok);
Exit;
end;
hWindow := WinCreate;
if longint(hWindow) = 0 then
begin
MessageBox(0, 'WinCreate failed', nil, mb_Ok);
Exit;
end;
while GetMessage(@AMessage, 0, 0, 0) do
begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;
Halt(AMessage.wParam);
end.
2015年01月04日 15点01分 7
代码源文藏在图片中
2015年01月04日 15点01分
1