Forums.Avtograd.Ru: Вопросы По Delphi, Pascal - Forums.Avtograd.Ru

Перейти к содержимому

  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

Вопросы По Delphi, Pascal

#1 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 01 Ноябрь 2007 - 13:22

Сабж :rolleyes:
0


  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

Другие ответы в этой теме

#81 Пользователь офлайн   musashi

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 573
  • Регистрация: 01 Ноябрь 07

Отправлено 12 Декабрь 2007 - 21:43

зачем тебе имя я никак непойму, хендл уникальная штука, используй его!
можно даже не массив, а структуру создать, для хранения всей необходимой инфы!
0

#82 Пользователь офлайн   Barrabas

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 431
  • Регистрация: 01 Ноябрь 07

Отправлено 12 Декабрь 2007 - 23:10

Просмотр сообщенияKORENHACK (12.12.2007, 20:18):

Как узнать имя созданного объекта? Оно автоматически проставляется, т.е. twebbrowser1, twebbrowser2...?

ты притворяешься чтоль? объект.name
как ты создаешь объект twebbrowser?
0

#83 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 12 Декабрь 2007 - 23:25

Ы что никто не в курсе почему когда ШеллЭкзекутом файл справки показываем, классическое оформление у окна справочной системы?
0

#84 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 13 Декабрь 2007 - 07:19

Просмотр сообщенияException (12.12.2007, 23:25):

Ы что никто не в курсе почему когда ШеллЭкзекутом файл справки показываем, классическое оформление у окна справочной системы?
наверное какой то механизм совместимости задействуется.
0

#85 Пользователь офлайн   DartV

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 238
  • Регистрация: 01 Ноябрь 07

Отправлено 14 Декабрь 2007 - 12:05

Просмотр сообщенияKORENHACK (12.12.2007, 19:13):

tpagecontrol

в TPageControl все страници - это компоненты типа TTabSheet , а у них как и у всех компонентов есть свойство Tag, и им можно воспользоваться. При создании нового экземпляра TWebBrowser присваиваем этот экземпляр свойству Tag той вкладки на которой TWebBrowser и создаётся, например:
var NewTab:TTabSheet;
...
NewTab:=TTabSheet.Create(PageControl1)
NewTab.PageControl := PageControl1;
NewTab.Tag := integer(TWebBrowser.Create(Self));
with TWebBrowser(NewTab.Tag) do begin
 Parent:=NewTab;
 {здесь устанавливаем остальные свойства компонента TWebBrowser}
 end;

...

with TWebBrowser(PageControl1.ActivePage.Tag) do begin
 {здесь обращение в TWebBrowser активной вкладки}
 end;

Во второй части примера ActivePage можно заменить на Pages[Index] для доступа по индексу вкладки.
Меня можно найти в IRC на каналах #programmers, #delphimaster, #delphiintru @ irc.tlt.ru (Dalnet.Ru), ник - Amidamaru
0

#86 Пользователь офлайн   KORENHACK

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 464
  • Регистрация: 01 Ноябрь 07

Отправлено 18 Декабрь 2007 - 08:15

Всем спасибо, разобрался.
0

#87 Пользователь офлайн   Шустрый

  • Новичок
  • Pip
  • Группа: Пользователи
  • Сообщений: 1
  • Регистрация: 14 Декабрь 07

Отправлено 18 Декабрь 2007 - 14:03

У кого нибудь есть дистрибутив , чтобы из Edit добавлялись данные в документ Excel в определенные ячейки
не могу разобратся.
0

#88 Пользователь офлайн   Explorer

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 700
  • Регистрация: 09 Ноябрь 07

Отправлено 29 Декабрь 2007 - 11:47

Может кому-нибудь интересно. Пример кода для отображения температуры графического процессора видеокарт nVidia.

function GetTempCard : cardinal;
type
  NvCplGetThermalSettings = function(WindowsMonitorNumber : UINT; pGpuTemp, pUmgebTemp, pSlowDownTemp : Pointer) : BOOL; stdcall;
var
  hInstNvcpl : THandle;
  GetThermalSettings : NvCplGetThermalSettings;
  UmgebTemp, SlowDownTemp : cardinal;
begin
  Result := 0;
  UmgebTemp := 0;
  SlowDownTemp := 0;
  hInstNvcpl := LoadLibrary('nvcpl.dll');
  if hInstNvcpl <> 0 then
	try
	  GetThermalSettings := GetProcAddress(hInstNvcpl, 'NvCplGetThermalSettings');
	  if Assigned(GetThermalSettings)  then
		GetThermalSettings(0, Addr(Result), Addr(UmgebTemp), Addr(SlowDownTemp));
	finally
	  FreeLibrary(hInstNvcpl);
	end;
end;

PChar(IntToStr(GetTempCard))

0

#89 Пользователь офлайн   Grast

  • Новичок
  • Pip
  • Группа: Пользователи
  • Сообщений: 39
  • Регистрация: 01 Ноябрь 07

Отправлено 26 Январь 2008 - 10:55

как сделать чтобы программу нельзя было запустить еще раз, если она уже запущена?
0

#90 Пользователь офлайн   TRUTHFUL

  • Пользователь
  • PipPip
  • Группа: Модераторы
  • Сообщений: 412
  • Регистрация: 01 Ноябрь 07

Отправлено 26 Январь 2008 - 13:27

Просмотр сообщенияExplorer (29.12.2007, 11:47):

Может кому-нибудь интересно. Пример кода для отображения температуры графического процессора видеокарт nVidia.

Ага, мне было интересно. Во первых твоя процедура не возвращает значения. А во вторых, те три переменных, которые заполняются температурами в твоей процедуре у меня заполняются нулями. Если ты там что-то сам редактировал, то выложи полностью. Проверь вобщем.
Истина где-то рядом... Пускай там и остается!
0

#91 Пользователь офлайн   Explorer

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 700
  • Регистрация: 09 Ноябрь 07

Отправлено 26 Январь 2008 - 15:23

Просмотр сообщенияTRUTHFUL (26.1.2008, 13:27):

Ага, мне было интересно. Во первых твоя процедура не возвращает значения. А во вторых, те три переменных, которые заполняются температурами в твоей процедуре у меня заполняются нулями. Если ты там что-то сам редактировал, то выложи полностью. Проверь вобщем.

У меня все работает. Вот пример (извиняюсь, только на api, так как на vcl разучился).

program tempstatus;
uses
  Windows, Messages;

{$R resourse.res}

const
  IDD_DIALOG = 101;
  IDC_STATIC = 100;
  IDC_TIMER = 1;
var
  Timer: Cardinal = 0;

function IntToStr(Int : Int64) : String;
begin
  Str(Int, Result);
end;

function GetTempCard : Cardinal;
type
  NvCplGetThermalSettings = function(WindowsMonitorNumber : UINT; pGpuTemp, pUmgebTemp, pSlowDownTemp : Pointer) : BOOL; stdcall;
var
  hInstNvcpl : THandle;
  GetThermalSettings : NvCplGetThermalSettings;
  UmgebTemp, SlowDownTemp : Cardinal;
begin
  Result := 0;
  UmgebTemp := 0;
  SlowDownTemp := 0;
  hInstNvcpl := LoadLibrary('nvcpl.dll');
  if hInstNvcpl <> 0 then
	try
	  GetThermalSettings := GetProcAddress(hInstNvcpl, 'NvCplGetThermalSettings');
	  if Assigned(GetThermalSettings)  then
		GetThermalSettings(0, Addr(Result), Addr(UmgebTemp), Addr(SlowDownTemp));
	finally
	  FreeLibrary(hInstNvcpl);
	end;
end;

function DlgFunc(hWnd: HWND; uMsg: Cardinal; wParam: wParam; lParam: lParam) : Bool; stdcall;
begin
  Result := TRUE;
  case umsg of
	WM_INITDIALOG : Timer := SetTimer(hWnd, IDC_TIMER, 500, nil);
	WM_CLOSE:
	  begin
		if Timer <> 0 then KillTimer(hWnd, Timer);
		EndDialog(hwnd, 0);
	  end;
	WM_LBUTTONDOWN : SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, lParam);
	WM_TIMER : SetDlgItemText(hWnd,IDC_STATIC, PChar(IntToStr(GetTempCard)));
  else Result := FALSE;
  end;
end;

begin
  DialogBox(hInstance, MAKEINTRESOURCE(IDD_DIALOG), 0, @DlgFunc);
end.


101 DIALOGEX 0, 0, 70, 25
STYLE DS_CENTER | WS_VISIBLE | WS_CAPTION
CAPTION ""
LANGUAGE LANG_RUSSIAN, 0x1
FONT 8, "Tahoma"
{
   CONTROL "", 100, STATIC, SS_CENTER | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 10, 10, 50, 10 , 0x00020000
}

0

#92 Пользователь офлайн   Keks

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 398
  • Регистрация: 01 Ноябрь 07

Отправлено 31 Январь 2008 - 19:49

Народ подскажите, как микрофон включить/выключить (или сбросить его громкость на 0%). Ну аналогия снять или поставить галочку "Выкл" в микшере Windows. Только осуществить это нужно из программы не открывая микшер.
В инете почитал про:

uses
MMSystem;

и функции:

waveOutSetVolume()
waveInStart()
waveInStop()

но что-то с ними неполучилось, может подскажет кто?

0

#93 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 02 Февраль 2008 - 00:53

Просмотр сообщенияKeks (31.1.2008, 19:49):

Народ подскажите, как микрофон включить/выключить (или сбросить его громкость на 0%). Ну аналогия снять или поставить галочку "Выкл" в микшере Windows. Только осуществить это нужно из программы не открывая микшер.
В инете почитал про:

uses
MMSystem;

и функции:

waveOutSetVolume()
waveInStart()
waveInStop()

но что-то с ними неполучилось, может подскажет кто?

procedure OutSetVolume;
var 
newvolume:word;  
begin 
newvolume:= TtrackBar1.Position; 
WaveOutSetVolume(wave_mapper, NewVolume or (NewVolume shl 16));
end;


или

procedure SetVolume(const volL, volR: Word); 
var 
  hWO: HWAVEOUT; 
  waveF: TWAVEFORMATEX; 
  vol: DWORD; 
begin 
  // init TWAVEFORMATEX 
  FillChar(waveF, SizeOf(waveF), 0); 
  // open WaveMapper = std output of playsound 
  waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0); 
  vol:= volL + volR shl 16; 
  // set volume 
  waveOutSetVolume(hWO, vol); 
  waveOutClose(hWO); 
end;


эээ пойдет?
0

#94 Пользователь офлайн   Keks

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 398
  • Регистрация: 01 Ноябрь 07

Отправлено 02 Февраль 2008 - 16:35

Несовсем то, мне нужно регулировать громкомть микрофона, а не всей системы.
Может вместо "wave_mapper" подставить какую-нибудь переменную указывающую на канал микрофона?

0

#95 Пользователь офлайн   Keks

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 398
  • Регистрация: 01 Ноябрь 07

Отправлено 02 Февраль 2008 - 17:02

Всё спс, вопрос решился сам собой нашел в Delphi World6 (после обновления)
если кому интересно:

 unit Unit1;

interface

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

type

	TMixerLineSourceType = (lsDigital, lsLine, lsMicrophone, lsCompactDisk,
	lsTelephone,
	lsWaveOut, lsAuxiliary, lsAnalog, lsLast);


  TForm1 = class(TForm)
	Button1: TButton;
	Button2: TButton;
	procedure Button1Click(Sender: TObject);
	procedure Button2Click(Sender: TObject);
  private
	{ Private declarations }
  public
	{ Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

function SetMixerLineSourceMute(AMixerLineSourceType: TMixerLineSourceType;
  bMute: Boolean): Boolean;
var
  hMix: HMIXER;
  mxlc: MIXERLINECONTROLS;
  mxcd: TMIXERCONTROLDETAILS;
  vol: TMIXERCONTROLDETAILS_UNSIGNED;
  mxc: MIXERCONTROL;
  mxl: TMixerLine;
  intRet: Integer;
  nMixerDevs: Integer;
  mcdMute: MIXERCONTROLDETAILS_BOOLEAN;
begin
  Result := False;
  // Check if Mixer is available
  // Uberprufen, ob ein Mixer vorhanden ist
  nMixerDevs := mixerGetNumDevs();
  if (nMixerDevs < 1) then
  begin
	Exit;
  end;

  // open the mixer
  // Mixer offnen
  intRet := mixerOpen(@hMix, 0, 0, 0, 0);
  if intRet = MMSYSERR_NOERROR then
  begin
	ZeroMemory(@mxl, SizeOf(mxl));
	case AMixerLineSourceType of
	  lsDigital: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_DIGITAL;
	  lsLine: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_LINE;
	  lsMicrophone: mxl.dwComponentType :=
		MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE;
	  lsCompactDisk: mxl.dwComponentType :=
		MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC;
	  lsTelephone: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE;
	  lsWaveOut: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT;
	  lsAuxiliary: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY;
	  lsAnalog: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_ANALOG;
	  lsLast: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_LAST;
	end;

	// mixerline info
	mxl.cbStruct := SizeOf(mxl);
	intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);

	if intRet = MMSYSERR_NOERROR then
	begin
	  ZeroMemory(@mxlc, SizeOf(mxlc));
	  mxlc.cbStruct := SizeOf(mxlc);
	  mxlc.dwLineID := mxl.dwLineID;
	  mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
	  mxlc.cControls := 1;
	  mxlc.cbmxctrl := SizeOf(mxc);
	  mxlc.pamxctrl := @mxc;

	  // Get the mute control
	  // Mute control ermitteln
	  intRet := mixerGetLineControls(hMix, @mxlc,
		MIXER_GETLINECONTROLSF_ONEBYTYPE);

	  if intRet = MMSYSERR_NOERROR then
	  begin
		ZeroMemory(@mxcd, SizeOf(mxcd));
		mxcd.cbStruct := SizeOf(TMIXERCONTROLDETAILS);
		mxcd.dwControlID := mxc.dwControlID;
		mxcd.cChannels := 1;
		mxcd.cbDetails := SizeOf(MIXERCONTROLDETAILS_BOOLEAN);
		mxcd.paDetails := @mcdMute;

		mcdMute.fValue := Ord(bMute);

		// set, unset mute
		// Stumsschalten ein/aus
		intRet := mixerSetControlDetails(hMix, @mxcd,
		  MIXER_SETCONTROLDETAILSF_VALUE);
		{
		mixerGetControlDetails(hMix, @mxcd, IXER_GETCONTROLDETAILSF_VALUE);
		Result := Boolean(mcdMute.fValue);
		}
		Result := intRet = MMSYSERR_NOERROR;

		if intRet <> MMSYSERR_NOERROR then
		  ShowMessage('SetControlDetails Error');
	  end
	  else
		ShowMessage('GetLineInfo Error');
	end;
	intRet := mixerClose(hMix);
  end;
end;






procedure TForm1.Button1Click(Sender: TObject);
begin
  SetMixerLineSourceMute(lsMicrophone, True);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  SetMixerLineSourceMute(lsMicrophone, False);
end;

end.


0

#96 Пользователь офлайн   Saray

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 2 388
  • Регистрация: 31 Январь 08

Отправлено 11 Февраль 2008 - 08:35

Просмотр сообщенияGrast (26.1.2008, 10:55):

как сделать чтобы программу нельзя было запустить еще раз, если она уже запущена?

uses syncobjs;

var
CheckEvent: TEvent;
//---

procedure TfmMain.FormCreate(Sender: TObject);
begin
CheckEvent:= TEvent.Create( nil, false, true, 'MYPROGRAM_CHECKEXIST' );
if CheckEvent.WaitFor( 10 ) <> wrSignaled then
begin
Application.MessageBox('Программа уже запущена','Ошибка!',MB_IConerror);
halt;
end
end;
Если женщина не права, нужно извиниться и замолчать.
0

#97 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 11 Февраль 2008 - 15:36

Можно проще:

CreateSemaphore(nil, 0, 1, 'Название любое');
if (GetLastError = ERROR_ALREADY_EXISTS) then MessageBox(Handle, 'ЫЫЫ... Уже есть запущенная копия...', 'Сообщение', MB_IConstop);
0

#98 Пользователь офлайн   KORENHACK

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 464
  • Регистрация: 01 Ноябрь 07

Отправлено 11 Февраль 2008 - 19:19

как обеспечить в delphi приложениии поддержку php скриптов?
0

#99 Пользователь офлайн   Macro-Z

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 397
  • Регистрация: 02 Ноябрь 07

Отправлено 11 Февраль 2008 - 22:03

Просмотр сообщенияKORENHACK (11.2.2008, 19:19):

как обеспечить в delphi приложениии поддержку php скриптов?
:lol:
Установи PHP и перенаправь стандартный вывод в твою программу !
0

#100 Пользователь офлайн   Administr

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 328
  • Регистрация: 08 Ноябрь 07

Отправлено 11 Февраль 2008 - 22:10

народ подскажите плз быстренько функцию вызова диалога открытия файла в восьмом делфи, а то я что-то забыл...
Вебмастер: продвижение, разработка, дизайн, верстка и др. контакты в профиле. Люблю советские электрогитары, куплю или приму в дар электрогитары или запчасти от них. Интересуют все модели с этого сайта: http://oecc.ru/
0

  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

1 человек читают эту тему
0 пользователей, 1 гостей, 0 скрытых пользователей