Вверх ↑
Этот топик читают: Guest
Ответов: 217
#1: 2014-09-04 23:22:29 ЛС | профиль | цитата


Здравствуйте форумчане. Когда-то давно мной была разработана программа MineLHC. Многие схемы баков сейчас делают именно на ней, и я это вижу.
Но ни времени, ни желания апнуть до 2-го уровня свое детище я не вижу, поэтому предоставлю исходный код любому желающему, ЛС, так как правила форума не позволяют мне выложить все сюда. Единственная просьба - если решите ее усовершенствовать, сохраните данные авторов и всех причастных к проекту.

Вот, так, для обсуждения кусок кода.

mainunit
unit mainunit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons;


type
TMainForm = class(TForm)
Panel: TPanel;
SaveDialog: TSaveDialog;
BlocksImage: TImage;
Shape: TShape;
ScrollBox: TScrollBox;
Image: TImage;
AboutButton: TSpeedButton;
LoadButton: TSpeedButton;
SaveButton: TSpeedButton;
NewButton: TSpeedButton;
OpenDialog: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure BlocksImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormResize(Sender: TObject);
procedure LoadButtonClick(Sender: TObject);
procedure AboutButtonClick(Sender: TObject);
procedure SaveButtonClick(Sender: TObject);
procedure NewButtonClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure NewField(SizeX2,SizeY2:byte);
end;

var
MainForm: TMainForm;
XS,YS: Byte;
BlockID: byte;
SRect: TRect;
FRect: TRect;
Bmp, Bmp2: TBitmap;
Tr: byte;
Centered: boolean;
OldPos, NewPos: TPoint;
CRect: TRect;
SizeX,SizeY: byte;
const
ScaleSize = 32;
ScaleSize2 = 32;

implementation

uses setuppageunit, aboutunit;

{$R *.dfm}

procedure TMainForm.NewButtonClick(Sender: TObject);
begin
setuppageform.ShowModal;
end;

procedure TMainForm.NewField(SizeX2: Byte; SizeY2: Byte);
begin
Image.Height := SizeY2*ScaleSize;
Image.Width := SizeX2*ScaleSize;
Image.Picture.Bitmap.SetSize(SizeX2*ScaleSize,SizeY2*ScaleSize);
Image.Canvas.Brush.Color := clWhite;
Image.Canvas.FillRect(Rect(0,0,Image.Picture.Bitmap.Width,Image.Picture.Bitmap.Height));
Image.Canvas.Pen.Color := RGB(150,150,150);
for XS := 0 to SizeX2 do
begin
Image.Canvas.MoveTo(XS*ScaleSize,0);
Image.Canvas.LineTo(XS*ScaleSize,SizeY2*ScaleSize);
end;

for YS := 0 to SizeY2 do
begin
Image.Canvas.MoveTo(0,YS*ScaleSize);
Image.Canvas.LineTo(SizeX2*ScaleSize,YS*ScaleSize);
end;
Image.Top := ClientHeight div 2 - Image.Height div 2;
Image.Left := ClientWidth div 2 - Image.Width div 2;
end;
procedure TMainForm.SaveButtonClick(Sender: TObject);
begin
if SaveDialog.Execute then
begin
Image.Picture.SaveToFile(SaveDialog.FileName+'.bmp');
end;
end;

procedure TMainForm.AboutButtonClick(Sender: TObject);
begin
AboutForm.ShowModal;
end;

procedure TMainForm.BlocksImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
BlockID := X div ScaleSize2;
Shape.Left := BlockID * ScaleSize2 + BlocksImage.Left;
end;



procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
Bmp.Free;
Bmp2.Free;
finally
//
end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
SizeX := 50;
SizeY := 50;
// --- shape data ---//
with Shape do
begin
Top := BlocksImage.Top;
Left := BlocksImage.Left;
Width := ScaleSize2;
Height := ScaleSize2;
end;
// ---


// CRect data ---//
with CRect do
begin
Left := 0;
Top := 0;
Bottom := ScaleSize;
Right := ScaleSize;
end;

// ---
Centered := false;
Bmp2 := TBitmap.Create;
Bmp2.SetSize(ScaleSize,ScaleSize);
Bmp2.Canvas.Brush.Color := RGB(150,150,150);
Bmp2.Canvas.FillRect(CRect);
CRect.Left := CRect.Left +1;
CRect.Top := CRect.Top + 1;
Bmp2.Canvas.Brush.Color := RGB(255,255,255);
Bmp2.Canvas.FillRect(CRect);
CRect.Left := 0;
CRect.Top := 0;


Bmp := TBitmap.Create;
Bmp.SetSize(ScaleSize,ScaleSize);
SRect.Top := 0;
SRect.Bottom := ScaleSize2;
BlocksImage.Picture.LoadFromFile('blocks.bmp');
BlocksImage.Canvas.Pen.Width := 5;
BlocksImage.Canvas.Pen.Color := RGB(160,160,160);
NewField(SizeX,SizeY);

end;

procedure TMainForm.FormResize(Sender: TObject);
begin
if Centered = false then
begin
Image.Top := ClientHeight div 2 - Image.Height div 2;
Image.Left := ClientWidth div 2 - Image.Width div 2;
Centered := true;
end;
end;

procedure TMainForm.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FRect.Top := Y div ScaleSize * ScaleSize;
FRect.Bottom := Y div ScaleSize * ScaleSize + ScaleSize;

FRect.Left := X div ScaleSize * ScaleSize;
FRect.Right := X div ScaleSize * ScaleSize + ScaleSize;
if Button = mbleft then
begin
OldPos.X := X div ScaleSize;
OldPos.Y := Y div ScaleSize;
//here
SRect.Left := BlockID*ScaleSize2;
SRect.Right := BlockID*ScaleSize2+ScaleSize2;
Bmp.Canvas.CopyRect(CRect,BlocksImage.Canvas,SRect);
if BlockID = 0 then
begin
Bmp.Transparent := false;
Tr := 105;
Image.Canvas.Draw(FRect.Left,FRect.Top,Bmp,Tr);
end
else if BlockId ‹› 0 then
begin
Bmp.Transparent := true;
Bmp.TransparentColor := clWhite;
Tr := 255;
Image.Canvas.Draw(FRect.Left,FRect.Top,Bmp,Tr);
end;

end;

if Button = mbRight then
begin
Image.Canvas.CopyRect(FRect,Bmp2.Canvas,CRect);
end;
end;

procedure TMainForm.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin

// left click
if ssLeft in Shift then
begin
NewPos.X := X div ScaleSize;
NewPos.Y := Y div ScaleSize;
if (NewPos.X ‹› OldPos.X) or (NewPos.Y ‹› OldPos.Y) then
begin
FRect.Top := NewPos.Y * ScaleSize;
FRect.Bottom := NewPos.Y * ScaleSize + ScaleSize;

FRect.Left := NewPos.X * ScaleSize;
FRect.Right := NewPos.X * ScaleSize + ScaleSize;

SRect.Left := BlockID*ScaleSize2;
SRect.Right := BlockID*ScaleSize2+ScaleSize2;

Bmp.Canvas.CopyRect(CRect,BlocksImage.Canvas,SRect);

if BlockID = 0 then
begin
Bmp.Transparent := false;
Tr := 105;
Image.Canvas.Draw(FRect.Left,FRect.Top,Bmp,Tr);
end
else if BlockId ‹› 0 then
begin
Bmp.Transparent := true;
Bmp.TransparentColor := clWhite;
Tr := 255;
Image.Canvas.Draw(FRect.Left,FRect.Top,Bmp,Tr);
end;
OldPos.X := NewPos.X;
OldPos.Y := NewPos.Y;
end;
end



else
if ssRight in Shift then
begin
NewPos.X := X div ScaleSize;
NewPos.Y := Y div ScaleSize;
if (NewPos.X ‹› OldPos.X) or (NewPos.Y ‹› OldPos.Y) then
begin
FRect.Top := NewPos.Y * ScaleSize;
FRect.Bottom := NewPos.Y * ScaleSize + ScaleSize;

FRect.Left := NewPos.X * ScaleSize;
FRect.Right := NewPos.X * ScaleSize + ScaleSize;

Image.Canvas.CopyRect(FRect,Bmp2.Canvas,CRect);
OldPos.X := NewPos.X;
OldPos.Y := NewPos.Y;
end;
end;

end;


procedure TMainForm.LoadButtonClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
Image.Picture.LoadFromFile(OpenDialog.FileName);
Image.Width := Image.Picture.Bitmap.Width;
Image.Height := Image.Picture.Bitmap.Height;
Image.Top := ClientHeight div 2 - Image.Height div 2;
Image.Left := ClientWidth div 2 - Image.Width div 2;
end;
end;

end.

Просьба игрокам(хелперам),любящим указать мне нужное сообщество, не закрывать мою тему, т.к. я хочу чтобы исходный код был доступен всем желающим.
карма: -5
0
vip
#1.1контекстная реклама от партнеров
Ответов: 707
Ventris
лидер
#2: 2014-09-04 23:23:54 ЛС | профиль | цитата
Я думал исходняк был сложнее и выглядил по другому.
карма: 3
Nirvana-plateau
0
Ответов: 217
#3: 2014-09-04 23:24:44 ЛС | профиль | цитата
Здесь есть все что нужно - обработка перемещения мыши, сохранение/загрузка и прочее.

Редактировалось 1 раз(а), последний 2014-09-04 23:25:06
карма: -5
0
Ответов: 1385
#4: 2014-09-04 23:30:00 ЛС | профиль | цитата
Есть такое сообщество.
P.S.
Затралил

Редактировалось 1 раз(а), последний 2014-09-04 23:33:52
карма: -1
0
Ответов: 5318
Monte Carlo
Милашка
#5: 2014-09-04 23:34:02 ЛС | профиль | цитата
Ошибка в "Оставить свои отзывы вы можете в соответствующей теме на форуме".
карма: 25
— Слушай, а… сколько сейчас времени, ты не знаешь? Так, примерно, можешь почувствовать?
0
5
Сообщение
...