Последние записи
- Delphi 7: замостить TImage маленьким изображением
- Определить, что кнопка зажата сейчас
- ATmega128 — При появлении положительного фронта на входе PD3 запустить таймер-счётчик 0
- Можно вставить в HTML элемент из XML?
- Не получается запустить компьютер, при старте показывает no codec initialized
- Громкость звука (Делфи)
- Собрать post/get и куки параметры в одну переменную
- Создание окна ввода пароля на чистом Ассемблере
- Удаление пустых абзацев в ячейках таблиц (MS Word)
- Не создавать форму при определенном параметре
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
6th
Сен
Процесс создания sfx 7zip в картинках?
способ 1: выбираем файлы и папки для архивации. нажимаем “Добавить архив” (”+” зелёный). появится окно. в нём в “Опции” выбираем “Создать SFX-архив” и нажимаем “OK”.
способ 2: если хочется немного изменить вид проги…
берём “Res Hacker”, открываем файл 7z.sfx в папке с архиватором “7-zip”. изменяем всё, что нужно, запаковываем “UPX” и заменяем оригинальный файл 7z.sfx в папке с архиватором. далее по способу 1.
способ 3: создать архив 7z. взять sfx из папки с архиватором. можно ещё поизвращаться из способа 2. потом к готовому sfx приписываем 7z архив.
код:
можно даже сделать этот sfx с XP стилем.
для этого в Res Hacker открываем sfx файл. жмём “Действия\Добавить новый ресурс”. нажимаем кнопку “Файл с новым ресурсом…”, выбираем файл в архиве. дальше заполняем по картинке.
5th
Сен
Липкие обьекты
Как можно сделать эффект липких объектов?
Stilet:
Обработчик перемещения так чтоб картинки клеились к друг другу сбоку:
код:
Y: Integer);
var cx2,cx,pt2:TPoint;i:integer; r1,r2:double;
begin
if (pt.X>0)and(pt.Y>0) then begin
pt2:=TImage(Sender).ClientToScreen(Point(x,y));
TImage(Sender).Left:=TImage(Sender).Left+(pt2.X-pt.X);
TImage(Sender).Top:=TImage(Sender).Top+(pt2.y-pt.y);
pt:=pt2;
cx.X:=TImage(Sender).Left+TImage(Sender).Width div 2;
cx.y:=TImage(Sender).Top+TImage(Sender).Height div 2;
r1:=sqrt(sqr(TImage(Sender).Width)+sqrt(TImage(Sender).Height));
for i := 0 to ControlCount – 1 do begin
if (Controls is TImage)and(Controlssender) then begin
with TImage(Controls) do begin
cx2.X:=Left+Width div 2;
cx2.y:=Top+Height div 2;
r2:=sqrt(sqr(Width)+sqrt(Height));
if sqrt(sqr(cx.X-cx2.X)+sqr(cx.y-cx2.y))<((r2+r1)/2+20) then begin
//******************************************
if (cx.X>cx2.X) then begin
TImage(Sender).Left:=Left+Width;
TImage(Sender).Top:=top;
end;
if (cx.X<cx2.X) then begin
TImage(Sender).Left:=Left-Width;
TImage(Sender).Top:=top;
end;
//******************************************
end;
end;
end;
end;
end;
end;
5th
Вывод содержимого папки
Пример выводит содержащиеся в папке файлы и папки.
код:
{$APPTYPE CONSOLE}
uses SysUtils;
var
Dir : String;
SearchRec: TSearchRec;
begin
WriteLn;
Write(’What’’s directory need dir ? ‘);
Readln(Dir);
Dir := IncludeTrailingBackslash(Dir);
if FindFirst(Dir + ‘*.*’, faAnyFile, SearchRec) = 0 then
repeat
if (SearchRec.Attr and faDirectory) 0 then begin
if (SearchRec.name ‘.’) and (SearchRec.name ‘..’) then
WriteLn(Dir + SearchRec.name,’ ‘)
end
else
WriteLn(Dir + SearchRec.name,’ ‘,SearchRec.Size);
until FindNext(SearchRec) 0;
FindClose(SearchRec);
end.
5th
Выход из бесконечного цикла
Вот, например, использую я бесконечный цикл, активируемый 1-й кнопкой. Что написать во 2-й кнопке, чтобы она остановила цикл?
DeKot:
Application.ProcessMessage позволяет влезть в любой цикл и дать команду на прерывание цикла или же полностью закрыть приложение (Halt).
Простой пример – на форме кнопки Пуск и Стоп цикла. В цикле мигает квадратик.
код:
begin
flag:= true;
BStop.SetFocus;
while flag = true do
begin
Inc(cnt);
if (cnt mod 10000) = 0 then begin_color:= not_color; cnt:= 1; end;
if _color = true then Form1.Canvas.Brush.Color:= clRed
else Form1.Canvas.Brush.Color:= clBtnFace;
Form1.Canvas.Rectangle(100,100,150,150);
Application.ProcessMessages;
end;
end;
procedure TForm1.BStopClick(Sender: TObject); // Стоп по кнопке на форме
begin
flag:= false;
Form1.Canvas.Brush.Color:= clBtnFace;
Form1.Canvas.Rectangle(100,100,150,150);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; // Стоп по клавише клавиатуры (любая)
Shift: TShiftState);
begin
BStopClick(Sender);
end;
Прерывание цикла или по кнопке формы или по любой клавише клавиатуры.
Полоностью проект во вложении. Прерывания цикла.rar
5th
Рассылка. Выпуск 74.
Posted by bullvinkle under Рассылка
От ведущего.
Здравствуйте, дорогие читатели. Сегодня выходит очередной выпуск рассылки от клуба. В этом номере смотрим интересныетемы форума, а так же новость о и призыв к участию в оформлении журнала, точнее его логотипа. И конечно же, отчет о конкурсе программистов.
5th
Отчет по конкурсу программистов
Сайт – http://pkonkurs.ru/
1 конкурс проходил в 1 этап
Обсуждение http://programmersforum.ru/showthread.php?t=81296
Результаты http://pblog.ru/?p=702
Участников было 5 – 2 первых места награждались.
2 Конкурс проходит в 3 этапа.
Были найдены спонсоры и выделено призовые – футболки и толстовка от printdirect.ru
Более 3000 рублей от mixmarket.ru, onegadget.ru, programmersforum.ru.
15 июля
Обсуждение – http://programmersforum.ru/showthread.php?t=92365
Результаты – http://pkonkurs.ru/Первая-битва-Результаты/
Участников было 6 – все 6 были награждены разными призами – футболка + 1000 рублей призовых
15 августа
Обсуждение – http://programmersforum.ru/showthread.php?t=107618
Результаты – http://pkonkurs.ru/Вторая-битва-Результаты/
Участников было 7 – 3 старых бота и 4 новых. Новые боты были доработаны и обучены побеждать старых и потому заняли все призовые места. Призы – толстовка + 2 майки + 100 рублей.
15 сентября
Обсуждение – http://programmersforum.ru/showthread.php?t=110428
Ждем еще несколько ботов и разыгрываем почти 2000 рублей.
Первое место 500 далее 400, 300, 200 и по 100 рублей всем кто пришлет ботов, которые победят симпл бота – простого бота.
География участников и победителей
Итоги и выводы
Конкурс оказался довольно сложным и потому не каждый смог или не захотел в нём принимать участие. После первого конкурса были продемонстрированы боты которых довольно сложно победить, потому присылались только – продвинутые боты, которые легко обыгрывали простых ботов поставлявшихся со сборкой.
Я как участник потратил по 2 дня на написание каждого нового бота. И с пятого места продвинулся на первое во втором этапе, что приятно. Выделенный мной на конкурс спонсорский взнос – постепенно возвращается
Также была создана витрина с клубными футболками – http://programmersforum.printdirect.ru/
После получения призов жду отзывы о продукции и печати и при хорошей оценке – оставлю эту ссылку в навигации и на следующее лето разработаем новые дизайны.
И последнее – на всех сайта клуба была встроена реклама от mixmarket.biz, в планах запуск каталога.
5th
Собственные часы в трее
Я написал программу(часы). Как мне эти часы поместить в трей т.е. как стандартные часы виндоса.
Stilet:
Вот как я представляю собственные часы в трее
код:
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var v:variant;
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var h:HWND;wp:WINDOWPLACEMENT;
begin
h:=FindWindow(’Shell_TrayWnd’,”);
h:=FindWindowEx(h,0,’TrayNotifyWnd’,”);
h:=GetWindow(h,GW_CHILD);
Align:=alClient;
BorderStyle:=bsNone;
top:=0;left:=0;
windows.SetParent(Handle,h);
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption:=TimeToStr(now);
end;
end.
4th
Сен
Бинарные файлы и C#
Есть бинарный файл, ин-фа в нем записана в виде структур, есть описание этих структур в заголовочном файле на c++.
подскажите как можно считать этот файл?
using System;
using System.IO;
namespace FileOperationsSample
{
class Program
{
static void Main(string[] args)
{
// Create the new, empty data file.
string fileName = @"C:\Temp.data";
if (File.Exists(fileName))
{
Console.WriteLine(fileName + " already exists!");
return;
}
FileStream fs = new FileStream(fileName, FileMode.CreateNew);
// Create the writer for data.
BinaryWriter w = new BinaryWriter(fs);
// Write data to Test.data.
for (int i = 0; i < 11; i++)
{
w.Write((int)i);
}
w.Close();
fs.Close();
// Create the reader for data.
fs = new FileStream(fileName, FileMode.Open, FileAccess.Read);
BinaryReader r = new BinaryReader(fs);
// Read data from Test.data.
for (int i = 0; i < 11; i++)
{
Console.WriteLine(r.ReadInt32());
}
r.Close();
fs.Close();
}
}
}
4th
Как узнать к какому процессу принадлежит известный класс окна
const
// Размер буфера, резервируемого для имени класса при
// использовании функций GetClassName и GetReadWindowClass
ClassNameLen = 512;
function EnumWindowProc(Wind: HWND; LI: TListItem): BOOL; stdcall;
var
Text: string;
TextLen: Integer;
ClassName: array[0..ClassNameLen - 1] of Char;
begin
Result := True;
TextLen := GetWindowTextLength(Wind);
SetLength(Text, TextLen);
if TextLen > 0 then
GetWindowText(Wind, PChar(Text), TextLen + 1);
if TextLen > 100 then
Text := Copy(Text, 1, 100) + ' ...';
GetClassName(Wind, ClassName, ClassNameLen);
ClassName[ClassNameLen - 1] := #0;
LI := AddAppForm.AppWindList.Items.add;
LI.Caption := IntToStr(Wind);
LI.SubItems.Add(ClassName);
if Text = '' then
LI.SubItems.Add('без имени')
else
LI.SubItems.Add(Text);
end;
function EnumTopWindowProc(Wind: HWND; PID: Cardinal): BOOL; stdcall;
var
Text: string;
TextLen: Integer;
ClassName: array[0..ClassNameLen - 1] of Char;
WindPID: Cardinal;
LI: TListItem;
begin
Result := True;
GetWindowThreadProcessId(Wind, @WindPID);
if WindPID = PID then
begin
TextLen := GetWindowTextLength(Wind);
SetLength(Text, TextLen);
if TextLen > 0 then
GetWindowText(Wind, PChar(Text), TextLen + 1);
if TextLen > 100 then
Text := Copy(Text, 1, 100) + ' ...';
GetClassName(Wind, ClassName, ClassNameLen);
ClassName[ClassNameLen - 1] := #0;
LI := AddAppForm.AppWindList.Items.add;
LI.Caption := IntToStr(Wind);
LI.SubItems.Add(ClassName);
if Text = '' then
LI.SubItems.Add('без имени')
else
LI.SubItems.Add(Text);
//EnumChildWindows(Wind,@EnumWindowProc,LParam(LI));
end;
end;
function GetProcessPID(ExeFileName: string): Cardinal;
var
ContinueLoop: Bool;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.DwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if ((AnsiUpperCase(ExtractFileName(FProcessEntry32.SzExeFile)) =
AnsiUpperCase(ExeFileName)) or (AnsiUpperCase(FProcessEntry32.SzExeFile) =
AnsiUpperCase(ExeFileName))) then
Result := FProcessEntry32.Th32ProcessID;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
function ProcessExists(ExeFileName: string): Boolean;
var
ContinueLoop: Bool;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := False;
FSnapshotHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.DwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if ((AnsiUpperCase(ExtractFileName(FProcessEntry32.SzExeFile)) =
AnsiUpperCase(ExeFileName)) or (AnsiUpperCase(FProcessEntry32.SzExeFile) =
AnsiUpperCase(ExeFileName))) then
begin
Result := True;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
procedure GetWindList(PID: Cardinal);
begin
if PID = 0 then
Exit;
EnumWindows(@EnumTopWindowProc, PID);
end;
2nd
Сен
Чтение данных с COM порта 232
#include <vcl.h>
#pragma hdrstop
#include <windows.h>
//---------------------------------------------------------------------------
/*
ZeroMemory (&dcb, sizeof (DCB));// не знает что ето такое
*/
//объявим структуру для асинхронной работы порта
OVERLAPPED over;
//для выделения сигнала
DWORD dwSignal;
//объявим структуру для конфигурации СОМ порта
DCB dcb;
//дескриптор порта
HANDLE hPortDat = NULL;
//переменная для чтения
char Data;
//==================================
//---------------------------------------------------------------------------
class MuClDataOutPort
{
private:
//пишим функцию инициализации порта
bool InnitPort ()
{
//открываем порт СОМ 1
hPortDat = CreateFile ("COM1", GENERIC_READ|GENERIC_WRITE,
0,NULL, OPEN_EXISTING,
FILE_FLAG_OVERLAPPED, NULL);
if (hPortDat == INVALID_HANDLE_VALUE)//если порт не удалось открыть
{
CloseHandle (hPortDat);
return false;//выходим из функции с ошибкой
}
//настраиваем параметры порта
dcb.BaudRate = CBR_19200;//скорость передачи
dcb.ByteSize = 8;//размер передачи
dcb.StopBits = ONESTOPBIT;//один стоповый бит
dcb.Parity = NULL;
//проверяем на правильность настройки
if ( !SetCommState ( hPortDat, &dcb)) //тоже не работает....
{
CloseHandle (hPortDat);
return false;//выходим из функции с ошибкой
}
//если все выполнилось то возвращаем положительный результат
return true;
}
//----------------------------------------------------
//функция чтения одного байта данных
BYTE ReadByteCOM ()
{
if (InnitPort ())
{
BYTE read = 0;
DWORD dwByteRead = 0;
do
{//читаем байт из порта
if (!ReadFile (hPortDat, &read, sizeof (BYTE), &dwByteRead, NULL))
{return 0xFF;}
} while (!dwByteRead);
return read;//возвращаем данные
}
else
{
return 0xFF;
}
}
//------------------------------------------------------
//функция чтения одного байта данных
bool WriteByteCOM (char bufer)
{
if (InnitPort ())
{
DWORD dwByteWrite = 0;
if (!WriteFile(hPortDat, &bufer, sizeof(char), &dwByteWrite, NULL))
{return false;}
return true;//возвращаем сведение о выполнении
}
else
{
return false;
}
}
//=============================================
//функция чтения массива данных
//=============================================
//=============================================
//=============================================
public:
//общая функция для работы с портом
void GeneralCOMRead ()
{
//проверяем сигнал в линии
if (dwSignal & EV_DSR)//данные готовы для чтения
{
//читаем байт из порта
Data = ReadByteCOM ();
//сохраняем байт куда-либо
}
}
//---------------------------------------------------------
void GeneralCOMWrite (char InData)
{
//проверяем сигнал в линии
if (dwSignal & EV_CTS)//данные готовы для записи
{
//пердаем байт из вне и записываем его в порт
WriteByteCOM (InData);
}
}
//---------------------------------------------------------
void CloseCOM ()
{
if (over.hEvent)
{
CloseHandle (over.hEvent);//закрываем объект событие
}
if (hPortDat)
{
CloseHandle (hPortDat);
hPortDat = NULL;
}
}
};
#pragma package(smart_init)
Облако меток
css реестр ассемблер timer SaveToFile ShellExecute программы массив советы word MySQL SQL ListView pos random компоненты дата LoadFromFile form база данных сеть html php RichEdit indy строки Win Api tstringlist Image мысли макросы Edit ListBox office C/C++ memo графика StringGrid canvas поиск файл Pascal форма Файлы интернет excel Microsoft Office Excel winapi журнал ПРОграммист DelphiКупить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)