Code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, PowerTypes, PowerDraw3, PowerTimers, PowerObjects, VTDbUnit,
PowerFonts, StdCtrls,PDrawEx, ExtCtrls, TranComp, VScreens;
type
TForm1 = class(TForm)
PowerDraw1: TPowerDraw;
PowerTimer1: TPowerTimer;
ImageList1: TAGFImageList;
PowerFont1: TPowerFont;
VTDb1: TVTDb;
VTDb2: TVTDb;
Timer1: TTimer;
VTDb3: TVTDb;
imagelist2: TAGFImageList;
procedure fundo;
procedure login;
procedure FormCreate(Sender: TObject);
procedure PowerDraw1DoneDevice(Sender: TObject);
procedure PowerDraw1InitDevice(Sender: TObject; var ExitCode: Integer);
procedure PowerTimer1Render(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Timer1Timer(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
contador, contador2, posX,posY : integer;
//texto : TStringList;
situacao : string;
retangulo : TRect;
inteiro : Boolean;
over_bot_login : Boolean;
over_bot_sair : Boolean;
implementation
uses Math, Unit2;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
res : integer;
begin
inteiro := true;
posX := 385;
posY := 235;
//texto := TStringList.Create;
contador := 0;
contador2 := 0;
Width := 800;
Height:= 600;
Res:= VTDb1.Initialize();
if (Res <> errNone) then
begin
MessageDlg('VTDb error: ' + ErrorString(Res), mtError, [mbOk], 0);
Application.Terminate();
Exit;
end;
Res:= VTDb2.Initialize();
if (Res <> errNone) then
begin
MessageDlg('VTDb error: ' + ErrorString(Res), mtError, [mbOk], 0);
Application.Terminate();
Exit;
end;
Res:= VTDb3.Initialize();
if (Res <> errNone) then
begin
MessageDlg('VTDb error: ' + ErrorString(Res), mtError, [mbOk], 0);
Application.Terminate();
Exit;
end;
Res:= PowerDraw1.Initialize();
if (Res <> errNone) then
begin
MessageDlg('PowerDraw error: ' + ErrorString(Res), mtError, [mbOk], 0);
Application.Terminate();
Exit;
end;
Res:= PowerDraw1.InitDevice();
if (Res <> errNone) then
begin
PowerDraw1.Finalize();
MessageDlg('Initialization error: ' + ErrorString(Res), mtError, [mbOk], 0);
Application.Terminate();
Exit;
end;
PowerTimer1.MayRender:= True;
situacao := 'login';
end;
procedure TForm1.PowerDraw1DoneDevice(Sender: TObject);
begin
PowerFont1.Finalize;
ImageList1.Finalize;
imagelist2.Finalize;
end;
procedure TForm1.PowerDraw1InitDevice(Sender: TObject; var ExitCode: Integer);
begin
ExitCode:= PowerFont1.LoadFromVTDb(VTDb1, 'zuric', PowerDraw1.DefTextureFormat);
if (ExitCode <> errNone) then
Exit;
ExitCode:= ImageList1.LoadFromVTDb(VTDb2);
if (ExitCode <> errNone) then
Exit;
ExitCode:= ImageList2.LoadFromVTDb(VTDb3);
if (ExitCode <> errNone) then
Exit;
end;
// ---------------------- INA_CIO DO TIMER ---------------------------
procedure TForm1.PowerTimer1Render(Sender: TObject);
begin
PowerDraw1.Clear($00000000);
PowerDraw1.BeginScene();
fundo;
if situacao = 'login' then
login;
PowerFont1.TextOut('Frame Rate: ' + IntToStr(PowerTimer1.FrameRate) + ' fps' +' Contador = '+inttostr(contador)+ ' posX ' + inttostr(posx)+ ' PosY '+inttostr(posY), 4, 580, $AFAFAF);
PowerDraw1.EndScene();
PowerDraw1.Present();
end;
// ---------------------- FINAL DO TIMER -----------------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
PowerDraw1.Finalize();
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
Res: Integer;
begin
if (Key = VK_ESCAPE) then Close();
if (Key = VK_RETURN)and(ssAlt in Shift) then
begin
PowerDraw1.DoneDevice();
PowerDraw1.Windowed:= not PowerDraw1.Windowed;
if (not PowerDraw1.Windowed) then
BorderStyle:= bsNone
else
BorderStyle:= bsSingle;
ClientWidth:= PowerDraw1.Width;
ClientHeight:= PowerDraw1.Height;
Res:= PowerDraw1.InitDevice();
if (Res <> errNone) then
begin
PowerDraw1.Finalize();
PowerTimer1.MayRender:= False;
MessageDlg('Initialization error: ' + ErrorString(Res), mtError, [mbOk], 0);
Close();
Exit;
end;
exit;
end;
if key = VK_LEFT then
posX := posX - 5;
if key = VK_RIGHT then
posX := posX + 5;
if key = VK_UP then
posY := posY - 5;
if key = VK_DOWN then
posY := posY + 5;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
contador := (contador + 1) mod 15;
end;
procedure TForm1.Login;
var
fundo : TRect;
begin
if inteiro then
begin
fundo.Top := janela_login_X+10;
fundo.Bottom:= janela_login_X + 90;
fundo.Left := janela_login_Y;
fundo.Right := janela_login_Y + 250;
PowerDraw1.FillRect(fundo,cColor4($00699600,$00699600,$00699600,$00699600),effectMultiply);
PowerDraw1.FillRect(janela_login_Y+60,janela_login_X+15,160,20,$808080,effectSrcColor);
PowerDraw1.FillRect(janela_login_Y+60,janela_login_X+40,160,20,$808080,effectSrcColor);
PowerFont1.TextOut('Login:', janela_login_Y+10, janela_login_X+15, $AFAFAF);
PowerFont1.TextOut('Pass:' , janela_login_Y+10, janela_login_X+40, $AFAFAF);
if over_bot_login then
PowerDraw1.TextureMap(ImageList1.Images[5], pBounds4(janela_login_Y+60,janela_login_X+65,50,15),cColor1($FFFFFFFF),tPattern(1),effectSrcAlpha)
else
PowerDraw1.TextureMap(ImageList1.Images[5], pBounds4(janela_login_Y+60,janela_login_X+65,50,15),cColor1($FFFFFFFF),tPattern(0),effectSrcAlpha);
if over_bot_sair then
PowerDraw1.TextureMap(ImageList1.Images[6], pBounds4(janela_login_Y+170,janela_login_X+65,50,15),cColor1($FFFFFFFF),tPattern(1),effectSrcAlpha)
else
PowerDraw1.TextureMap(ImageList1.Images[6], pBounds4(janela_login_Y+170,janela_login_X+65,50,15),cColor1($FFFFFFFF),tPattern(0),effectSrcAlpha);
PowerDraw1.TextureMap(ImageList1.Images[1], pBounds4(janela_login_Y,janela_login_X,250,90),cColor1($FFFFFFFF),tPattern(0),effectSrcAlpha);
end
else
PowerDraw1.TextureMap(ImageList1.Images[2], pBounds4(janela_login_Y,janela_login_X,250,10),cColor1($FFFFFFFF),tPattern(0),effectSrcAlpha);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var mousepos : TPoint;
begin
GetCursorPos(mousepos);
if situacao = 'login' then
begin
if pointinrect(mousepos,bounds(janela_login_Y,janela_login_X,ImageList1.Images[2].PatternWidth,10))then//ImageList1.Images[2].PatternHeight)) then
begin
pode_arrastar_login := true;
posicao_do_click_x := mousepos.x;
posicao_do_click_y := mousepos.y;
end;
if pointinrect(mousepos,bounds(janela_login_Y+230,janela_login_X,15,10))then//ImageList1.Images[2].PatternHeight)) then
inteiro := not inteiro;
if over_bot_sair then
close;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var mousepos : TPoint;
begin
Cursor := crDefault;
if situacao = 'login' then
begin
if pode_arrastar_login then
begin
if (x > 10) and (x < 790) then
begin
if posicao_do_click_x > x then
begin
janela_login_Y := janela_login_Y - (posicao_do_click_x - x);
posicao_do_click_x := x;
end;
if posicao_do_click_x < x then
begin
janela_login_Y := janela_login_Y + (x - posicao_do_click_x);
posicao_do_click_x := x;
end;
end;
if posicao_do_click_y > y then
begin
janela_login_X := janela_login_X - (posicao_do_click_y - y);
posicao_do_click_y := y;
end;
if posicao_do_click_Y < y then
begin
janela_login_X := janela_login_X + (y - posicao_do_click_y);
posicao_do_click_y := y;
end;
end;
GetCursorPos(mousepos);
if inteiro then
begin
if (pointinrect(mousepos,bounds(janela_login_Y+60,janela_login_X+40,160,20))) or (pointinrect(mousepos,bounds(janela_login_Y+60,janela_login_X+15,160,20)))then
Cursor := crIBeam
else
Cursor := crDefault;
if (pointinrect(mousepos,bounds(janela_login_Y+60,janela_login_X+65,50,15)))then
over_bot_login := true
else
over_bot_login := false;
if (pointinrect(mousepos,bounds(janela_login_Y+170,janela_login_X+65,50,15)))then
over_bot_sair := true
else
over_bot_sair := false;
end;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if situacao = 'login' then
pode_arrastar_login := false;
end;
procedure TForm1.FormDblClick(Sender: TObject);
var mousepos : TPoint;
begin
GetCursorPos(mousepos);
if situacao = 'login' then
begin
if pointinrect(mousepos,bounds(janela_login_Y,janela_login_X,250,10))then//ImageList
inteiro := not inteiro
end;
end;
procedure TForm1.fundo;
begin
if situacao = 'login' then
begin
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(0,0,200,200),cColor1($FFFFFFFF),tPattern(0),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(200,0,200,200),cColor1($FFFFFFFF),tPattern(1),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(400,0,200,200),cColor1($FFFFFFFF),tPattern(2),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(600,0,200,200),cColor1($FFFFFFFF),tPattern(3),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(0,200,200,200),cColor1($FFFFFFFF),tPattern(4),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(200,200,200,200),cColor1($FFFFFFFF),tPattern(5),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(400,200,200,200),cColor1($FFFFFFFF),tPattern(6),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(600,200,200,200),cColor1($FFFFFFFF),tPattern(7),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(0,400,200,200),cColor1($FFFFFFFF),tPattern(8),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(200,400,200,200),cColor1($FFFFFFFF),tPattern(9),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(400,400,200,200),cColor1($FFFFFFFF),tPattern(10),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[3], pBounds4(600,400,200,200),cColor1($FFFFFFFF),tPattern(11),effectNone);
PowerDraw1.TextureMap(ImageList1.Images[4], pBounds4(150,4,250,72),cColor1($FF104000),tPattern(0),effectAdd);
PowerDraw1.TextureMap(ImageList1.Images[4], pBounds4(400,4,250,72),cColor1($FF104000),tPattern(1),effectAdd);
PowerDraw1.TextureMap(ImageList1.Images[0], pBounds4(posX,posY,69,74),cColor1($FFFFFFFF),tPattern(contador),effectSrcColor);
end;
end;
end.
// ------------------------- UNIT 2 ----------------------------
var
janela_login_X : integer = 80;
janela_login_Y : integer = 500;
pode_arrastar_login : Boolean;
posicao_do_click_x , posicao_do_click_y : integer;
// ------------------------ END OF UNIT 2 ------------------------
Bookmarks