{
  Данный код был спроектирован в среде APIx - Visual WinAPI 2
  Copyright (c) PiddleSoft 2004-2006
  http://piddlesoft.narod.ru
  piddlesoft@mail.ru

  Дата генерации листинга - 19.07.2010 16:05:36
}

program APIx_Project26;

uses
  windows, messages, commctrl; //Используемые модули

// Иконка
{$R 'icon.res'}

var
  WinClass : TWndClass; //переменная класса TWndClass для создания главного окна
  hInst : HWND; //хандлер приложения
  Handle : HWND; //локальный хандлер
  Msg : TMSG; //сообщение
  Bmp : HBITMAP;
  hFont : HWND; //хандлер шрифта
  Image1 : HWND; //TImage

{$R 'D:\_MainDir\APIx 2 - Visual WinAPI\temp\bitmaps.res'}
procedure ShutDown; //процедура завершения программы
begin
  DeleteObject(hFont); //удаление шрифта
  UnRegisterClass('TAPIxForm', hInst); //удаление окна
  ExitProcess(hInst); //закрытие программы
end;

function WindowProc(hwnd, msg, wparam, lparam: longint): longint; stdcall; //обработчик сообщений
begin
  Result := DefWindowProc(hwnd, msg, wparam, lparam);
  case Msg of

  WM_DESTROY: ShutDown;
  end;
end;

begin
hInst := GetModuleHandle(nil);
  with WinClass do
  begin
   Style := CS_PARENTDC; //стиль класса главного окна
   hIcon := LoadIcon(hInst, MAKEINTRESOURCE('APIXICON')); //иконка программы
   lpfnWndProc := @WindowProc; //назначение обработчика сообщений
   hInstance := hInst;
   hbrBackground := COLOR_BTNFACE + 1; //цвет окна
   lpszClassName := 'TAPIxForm'; //класс окна
   hCursor := LoadCursor(0, IDC_ARROW); //активный курсор
  end;
InitCommonControls;
RegisterClass(WinClass); //регистрация класса в системе

// Создание главного окна программы
Handle := CreateWindowEx(0, 'TAPIxForm', 'Форма1',
WS_OVERLAPPEDWINDOW or
WS_VISIBLE or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU,
219, 116, 550, 366,
0, 0,
hInst, nil);

// Создание шрифта
hFont := CreateFont(
-11, 0, 0, 0, 0, 0, 0, 0,
DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS,
CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');

Image1 := CreateWindow(
'Static',
'' ,
WS_CHILD or SS_BITMAP or WS_VISIBLE,
104, 88, 225, 145, Handle, 0, hInst, nil);
SendMessage(Image1, WM_SETFONT, hFont, 0);
Bmp := LoadBitmap(hInstance, MAKEINTRESOURCE('Image1'));
SendMessage(Image1, STM_SETIMAGE, IMAGE_BITMAP, Bmp);

  // Цикл сбора сообщений
  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg); //прием сообщений
    DispatchMessage(Msg); //удаление сообщений из очереди
  end;
  end.

bmp – это HBitmap

Тема на форуме.

procedure GetRS(RS:TBitmap; Path: string);
var
  c: TCanvas;
   r: TRect;
   jpgImg: TJPEGImage;
begin
   c:=Tc.Create;
   c.Handle:=getWindowDC(GetDesktopWindow);
   try
      r:=Rect(0,0,screen.Width,screen.Height);
      RS.Width:=screen.Width;
      RS.Height:=screen.Height;
      RS.Canvas.CopyRect(r,c,r);
      RS.SaveToFile(Path);
      jpgImg := TJPEGImage.Create;
      jpgImg.Assign(RS);
      jpgImg.SaveToFile(Path)
finally
      ReleaseDC(0,c.Handle);
      c.Free;
      jpgImg.Free;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   b: TBitMap;
begin
   b:=TBitMap.Create;
   GetRS(b,ExtractFilePath(Application.ExeName) + IntToStr(i) + ‘.jpg’);
   b.Free;
   Inc(i);
end;

Тема на форуме

dmitriegorovih:

Значит у меня Delphi 7
кидаем на форму image1 и кнопку, чтоб создавались image(ы)
во “всеобщий var” пишем следующие

var
  x2,y2,n:integer;
  nagata:boolean;

в обработчике onmousedown пишем следующие
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
   nagata:=true;
  x2:=x;
  y2:=y;
end;

в обработчике onMouseMove пишем следующие
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
begin
  if nagata=true then begin
    if xx2 then begin
      Timage(sender).Left:=Timage(sender).Left+(x-x2)
    end;
    if yy2 then begin
      Timage(sender).Top:=Timage(sender).Top+(y-y2)
    end;
  end;
end;

в обработчике onMouseUp пишем следующие
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
  nagata:=false;
end;

по нажатию кнопки пишем следующие
procedure TForm1.Button1Click(Sender: TObject);
Var K:Timage;
Begin
  K:=Timage.create(self);
  k.parent:=self;
  k.picture:=image1.picture;
  k.onMouseMove:=image1.onMouseMove;
  k.onMouseDown:=image1. onMouseDown;
  k.onMouseUp:=image1.onMouseUp;
  k.name:=’Image_’+inttostr(n);
  inc(n);
end;

Ещё один способ:

Кидаем на форму TPanel На нее кидаем TImage, и расстягиваем Image на AlClient чтоб оно заполнило всю панель.
Далее в в обработчике зажатия мышки для Image пишем:

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
const Sc_dragmove = $F012;
begin
   ReleaseCapture;
   Panel1.Perform(WM_SYSCOMMAND, Sc_dragmove, 0);
end;

Тема на форуме

Posted by Chas under Пост-обзор

MySQL Data Access Components v5.90.0.57 (Delphi 5-2010)

MySQL Data Access Components (MyDAC) – это расширенная библиотека VCL / VCL DOT NET / CLX компонентов для быстрого прямого доступа к серверам MySQL из Delphi, C++Builder и Kylix. MyDAC тщательно протестирован на производительность и стабильность для обеспечения наиболее быстрого соединения по сетевому протоколу с MySQL.

— Прямой доступ к данным сервера. Не требует установки других средств доступа к данным (таких как BDE и ODBC).
— В Direct режиме не требует клиента MySQL, а работает напрямую через TCP/IP.
— Полная поддержка последних версий MySQL и всех типов данных MySQL.
— Disconnected Model с автоматическим контролем соединения для работы с данными в режиме offline.
— Local Failover для обнаружения потери соединения и перевыполнения определенных операций.
— Все типы локальной сортировки и фильтрации.
— Автоматическое обновление данных с помощью компонентов TMyQuery, TMyTable и TMyStoredComponents.
— Поддержка Unicode и национальных кодировок.
— Поддержка специфических для MySQL типов данных и функций, таких как блокировка, типы данных SET и ENUM.
— Расширенная функциональность выполнения скриптов при помощи компонента TMyScript.
— Поддержка макроподстановок в текстах запросов.
— Интеграция с MySQL Developer Tools для решения сложных задач разработки и администрирования баз данных.
— Простая миграция с BDE с помощью Migration Wizard.

Тема на форуме

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, GifImg, ExtCtrls;

type
   TForm30 = class(TForm)
     Image1: TImage;
     Timer1: TTimer;
     procedure Timer1Timer(Sender: TObject);
     procedure FormCreate(Sender: TObject);
   private
     Gif: TGifImage;
   public
     { Public declarations }
   end;

var
   Form30: TForm30;

implementation

{$R *.dfm}

procedure TForm30.FormCreate(Sender: TObject);
begin
   Gif := TGifImage.Create;
   Gif.LoadFromFile(’C:\Xom04.gif’);
   Gif.Animate := True;
   Gif.AnimateLoop := glEnabled;
end;

procedure TForm30.Timer1Timer(Sender: TObject);
begin
   Image1.Picture.Assign(Gif);
end;

end.

Тема на форуме

igh0st:

WebBrowser1.body.Style.overflow := “hidden”;

Тема на форуме

procedure TForm1.FormCreate(Sender : TObject);
var reg : TRegistry;
begin
   reg:=TRegistry.Create;
   Reg.RootKey:=HKEY_CLASSES_ROOT;
   reg.OpenKey(’.txt’, true);
   reg.WriteString(”,’txtfile’);
   reg.CloseKey;
   reg.CreateKey(’txt’+’DeDoK’;
   reg.OpenKey(’txtfile\DefaultIcon’, true);
   reg.WriteString(”,Application.ExeName+’,0′);
   reg.CloseKey;
   reg.OpenKey(’txtfile\shell\open\command’,true);
   reg.WriteString(”,Application.ExeName+’”%1″‘);
   reg.CloseKey;
   reg.Free;
end;

Тема на форуме

[MoNAMur]:

отрыл у себя на компьютере в папке “раритет” эти исходники.

интересно ваше мнение по поводу кода и полезности программы)))
да и может кому то понадобится какой-нибудь кусок кода.

программа получает данные о некоторых железках…

Исходник программы
Тема на форуме

Вот мы и подошли к заключительной серии наших уроков по графике в среде DELPHI. Сегодня рассмотрим практическое применение модуля <LoadObjectToBufferMod>, из нашего прошлого материала, на примере работы с движущимися графическими объектами…

Продолжение. Начало цикла смотрите в первом выпуске журнала…

Как работать с графикой на канве в среде Дельфи. Урок 7—8

Владимир Дегтярь

DeKot degvv@mail.ru

Проект с использованием дополнительного универсального модуля. Урок 7

Создайте и сохраните аналогично предыдущим урокам новый проект <Lesson 4>. В разделе uses введем модуль и в разделе var переменные для фона и звездолета ‘ship1 . Сам модуль должен находится в папке проекта (см. листинг 1):

Interface                          ЛИСТИНГ-1

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs,LoadObjectToBufferMod, ExtCtrls;

var

Form1: TForm1;

xf,yf: integer;             //  координаты  вывода  общего буфера  на форму

dyf: integer;               // приращение  изменения  координаты  yf  по вертикали

xS1,yS1: integer;        //  координаты  звездолета  'ship1'

dxS1,dyS1: integer;    // приращение  координат 'ship1' по гориз. и вертик.

xR,yR: integer;           //  координаты  звездолетов  'ship4' ...'ship7'

dyR: integer;              // приращение  координат 'ship2 - 5'

N_kadrS1: byte;          // номер изображения спрайта 'ship1'

implementation

В процедуре OnCreate() формы проведем инициализацию буферов и введем начальные данные для переменных (см. листинг 2):

procedure TForm1.FormCreate(Sender: TObject);          ЛИСТИНГ-2

begin

// инициализация и загрузка битовых образов буфера фона и общего буфера

InitFon(1,2,'data/star1.bmp');

LoadFon(0,0,'data/star1.bmp');

LoadFon(0,540,'data/star2.bmp');

InitBuff;

// начальные значения переменных

xS1:= 250; yS1:= 1006;

dxS1:= 5; dyS1:= 2;

xf:= 0; yf:= -540; dyf:= 2;

end;

Процедура InitFon() вызывается из модуля ‘1‘ – количество используемых файлов фона по ширине, ‘2‘ – по  высоте, ‘data/star1.bmp’ – по этому файлу определяем размеры основного буфера фона BufFon. Далее в процедурах loadFon() загружаем все файлы фона в BufFon. InitBuff() – инициализация буфера Buffer и загрузка в него фона. Движение графических объектов организовано в обработчике таймера (см. листинг 3):

procedure TForm1.Timer1Timer(Sender: TObject);            ЛИСТИНГ-3

begin

//  вывод  движения 'ship1'

N_kadrS1:= InitSprite('data/ship1.bmp',2,1,1,N_kadrS1);

LoadBuff(xS1-dxS1,yS1+dyS1,xS1,yS1,0);

Form1.Canvas.Draw(xf,yf,Buffer);

yf:=yf+dyf;  //  приращения  координат для движ. фона

if yf >= 0 then  // если половина  фона  "прошла" через окно формы

begin

yf:= -540; yS1:= 1006; // возврат к начальным координатам

FreeBuff; // "перезагрузка" фона

end;

yS1:= yS1 - dyS1;  // приращение для 'ship1',обратное приращению фона

end;

Функция InitSprite() возвращает номер следующего кадра (следующий рисунок спрайта ‘ship1’), который при следующем такте таймера опять передается в эту же функцию. В процедуре LoadBuff() предыдущее изображение спрайта перекрывается областью TRect фона и затем выводится новое изображение спрайта.

Когда весь фон проходит через окно формы в процедуре FreeBuff() фон снова перерисовывается в Buffer и возвращаются начальные координаты вывода Buffer на форму. Движение звездолета по горизонтали организовано в обработчике нажатия клавиш (см. листинг 4):

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;     ЛИСТИНГ-4

Shift: TShiftState);

begin

case Key of

VK_Left: begin        //  клавиша "стрелка" - влево

if xS1 <= 0 then EXIT; { если звездолет у левого края формы

xS1 не изменяется}

dxS1:= -5; // движение звездолета влево

xS1:= xS1 + dxS1;

end;

VK_Right: begin       //  клавиша "стрелка" - вправо

if xS1 >= 630 then EXIT; { если звездолет у правого края формы

xS1 не изменяется}

dxS1:= 5; // движение звездолета вправо

xS1:= xS1 + dxS1;

end;

end;

end;

Запустите данный проект. Получим приложение аналогичное проекту <Lesson 3>. Сравнив коды этих проектов, заметно преимущество применения модуля. Сам проект приведен в папке <Lesson 4_1> (см. ресурсы к статье). Мы же продолжим создание проекта <Lesson 4> далее, введя еще один движущийся

графический объект (звездолет из файлов ‘ship4’ … ‘ship7’). Эти файлы имеют разный размер и разное количество рисунков).

В разделе var введем переменные для нового графического объекта:

var

N_kadrR: byte;           // номер изображения спрайта 'ship4' ... 'ship7'

ns: byte = 5;               //  номер файла  спрайтов

Nspr: byte = 2;           //  кол-во изображений  в  строке файла  спрайтов

Добавим начальные значения новых этих переменных:

xs1 := 250; ys1 := 1006;      // начальные значения переменных-

dxs1:= 4;   dys1:= 2;

xf  := 0;   yf  := -540;      dyf:= 2;

xr := 50;         yr:= 450;

dyr:= 3;

Randomize;

В обработчике таймера для нового объекта повторно вызовем методы вывода изображений спрайтов (см. листинг 6):

// вывод движения ‘ship4-ship7’    ЛИСТИНГ-6

N_kadrR:= InitSprite(‘data/ship’ + inttostr(ns) + ‘.bmp’, Nspr, 1, 1, N, N_kadR);

LoadBuf(xR, yR – dyR, xR, yR, 0);

Form1.canvas.draw(xf, yf, Buffer);

yR:= yR + dyR; // приращение для ‘ship4-ship7’

if yR >= yS1 + 100 then // проход ‘ship4-ship7’ через окно формы

begin

xR:= random(600);

yR:= yS1 – 600;

ns:= random(4) + 4;

if ns = 7 then Nspr:= 4

else Nspr:= 2

end

end

Здесь, в функции InitSprite() переменная Nspr означает количество изображений в файле спрайтов и определяется по значению ns – номера файла нового объекта, который в свою очередь определяется функцией random() после каждого прохождения новым графическим объектом окна формы. Причем, движение ‘ship1’ аналогично предыдущим примерам в процедуре FormKeyDown(). Полностью проект приведен в папке <Lesson 4> (см. ресурсы к статье).

Развитие проекта Lesson 4. Урок 8

Продолжим наш проект <Lesson 4>, превратив его в небольшой «шутер» или попросту в «стрелялку».  Добавим также возможность стрельбы ракетами для ‘ship1’ по встречным звездолетам и эффект взрыва при попадании. Соответствующие графические файлы ракеты (bullet) и взрыва (explo) находятся в папке <data>. Сделаем это новым проектом с использованием проекта <Lesson 4>.

Итак, приступим… Создайте новую папку и присвойте ей имя <Lesson 5>. Скопируйте в нее все файлы

проекта <Lesson 4> и затем откройте проект в Delphi. Переименуем проект – File => Save Project as … и в диалоговом окне “Введите имя файла” – введите Lesson5 и сохраните проект под новым именем. Теперь снова откройте проект <Lesson 5> и добавьте переменные для новых объектов:

xb, yb: integer;        // координаты ракеты

dyb: integer;           // приращение координат ракеты

n_kadrb: byte;          // номер изображения ракеты

n_kadre: byte;          // номер изображения взрыва

vistrel,flag_s: boolean;

Флаги vistrel и flag_S типа Boolean необходимы для управления выводом изображения при выстреле ракетой. Случайный выбор звездолетов ‘ship4’ … ‘ship7’ выделим в отдельную процедуру, так как выбор в программе осуществляется несколько раз после прохождения звездолетом нижней границы окна формы, после попадания ракеты, а значит и уничтожения звездолета (см. листинг 7):

procedure randomship;            ЛИСТИНГ-7

begin

xr:= random(600);

yr:= ys1 – 600;

ns:= random(4) + 4;

if ns = 7 then nspr:= 4

else nspr:= 2

end;

В процедуре FormKeyDown() добавим обработку клавиши ”пробел” – пуск ракеты (см. листинг 8):

vk_space: // пробел – выстрел ЛИСТИНГ-8

if not vistrel then begin

xb:= xs1 +  22;

yb:= ys1 – 30;

dyb:= 20;

vistrel:= true

end;

В обработчике таймера выводим движение ракеты при произведенном пуске – флаг (см. листинг 9):

if yr >= ys1 + 100 then              ЛИСТИНГ-9

randomShip; // проход ship4-7 через окно формы

if (vistrel) and (not flag_s) then begin // если произведен выстрел, то

// вывод изображения ракеты

n_kadrb:= initSprite(‘data/bullet.bmp’, 1, 1, 1, n_kadrb);

loadBuff(xb, yb + dyb, yb, 0);

yb:= yb – dyb;

if yb <= ys1 – 510 then begin           // ракета вышла за пределы окна формы

vistrel:= false;

freeBuff                               // ПЕРЕЗАГРУЗКА фона

end

end;

и также вводим “эффект взрыва” при попадании ракеты в цель (см. листинг 10):

if (yb <= yr) and  ЛИСТИНГ-10

(xb >= xr) and

(xb <= xr+100) and

(vistrel) then begin

flag_s:= true;

dyb:= 0;

n_kadre:= initSprite(‘data/explo.bmp’, 8, 1, 1, n_kadre);

loadBuff(xb-54, yb + 2, xb-54, 0);

form1.canvas.draw(0, yf, buffer);

if n_kadre = 0 then begin // конец эффекта взрыва

vistrel:= false;

flag_s:= false;

freeBuff;

randomShip

end

end;

И собственно то, чего добивались. Скомпилируем и запустим наш проект (см. рисунок):

Рис. Окно проекта игры

Заключение

На этом мы закончим рассмотрение простейших приемов работы с движущимися графическими объектами. Предложу еще самостоятельно разобрать метод вывода на канву текстовой графики. Добавьте в код последнего приложения счетчики количества пусков ракет и попаданий в цель (например: count1, count2) и используя свойства Font(Size,Style,Color) и метод TextOut(X,Y, IntToStr(count..) введите статистику в приложении. Будем считать это домашним заданием…

Рассматриваемые в данной статье проекты полностью приведены в ресурсах к статье на http://www.programmersforum.ru в разделе «Журнал клуба программистов. Четвертый выпуск» (папка Lesson5*).

* Комментарий автора

Перед запуском в среде Дельфи скопируйте в папку с проектом папку data с графическими файлами.

Статья из четвертого выпуска журнала “ПРОграммист”.
Скачать этот номер можно по ссылке.
Ознакомиться со всеми номерами журнала.

Обсудить на форуме — Как работать с графикой на канве в среде Дельфи. Урок 7-8

var
   X, Y: LongInt;
begin
   Y := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
   X := Memo1.Perform(EM_LINEINDEX, Y, 0);
   inc(Y);
   X := Memo1.SelStart – X + 1;
   Form1.Caption := ‘X = ‘ + IntToStr(X) + ‘ : ‘ + ‘Y = ‘ + IntToStr(Y);
end;

тема на форуме