How can I select the soundcard to play my sound if I have a PC with two
soundcards.
now I´m using:
procedure TForm_Principal.FormCreate(Sender: TObject);
var
DevOutCaps: TWaveOutCaps;
n, i:Integer;
s: String;
begin
Self.comboOut.Items.Clear;
n := waveOutGetNumDevs;
for i := 0 to n-1 do
begin
waveOutGetDevCaps(i, #DevOutCaps, SizeOf(DevOutCaps));
s := PChar(#DevOutCaps.szPname);
Self.comboOut.Items.Add(s);
end;
end;
And then:
procedure TForm_Principal.Button1Click(Sender: TObject);
var
Res: TResourceStream;
begin
Res := TResourceStream.Create(HInstance, 'Sound_Ringing', RT_RCDATA);
try
Res.Position := 0;
PlaySound(Res.Memory,
Self.comboOut.ItemIndex, SND_MEMORY or SND_ASYNC );
//SndPlaySound(Res.Memory, SND_MEMORY or SND_ASYNC or SND_LOOP);
finally
Res.Free;
end;
end;
And it doesn't work, anyone can help me?
Thank you.
Related
I need help, please. I can connect to Gmail and I can receive emails.
What I can't do is to save attachments. I think that it is a setting problem? I have IdAttachment and IdAttachmentFile in my uses clause. I tried all sorts of ContentType settings, but nothing seams to work.
if (IdMessage1.MessageParts.Items[i] is TIdAttachment) then
begin
with (IdMessage1.MessageParts.Items[i] as TIdAttachment) do
begin
SaveToFile('C:\test123.txt');
end;
end;
Here is my code:
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
IdSSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
bodytext: string;
s: string;
n: string;
mailcount : integer;
TMP: string;
begin
IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
idpop31.IOHandler := IdSSLIOHandlerSocket;
idpop31.UseTLS := utUseImplicitTLS;
IdPOP31.Host := 'pop.gmail.com';
IdPOP31.Port := 995;
IdPOP31.UseTLS := utUseImplicitTLS;
IdPOP31.Username := 'name#gmail.com';
IdPOP31.Password := 'xxxxx';
IdPOP31.Connect;
Mailcount:= idpop31.checkmessages;
For i:= 1 to mailcount do
Begin
Idmessage1.clear;
Idpop31.retrieveheader (i,idmessage1);
TMP:= idmessage1.subject;
Mailzeug.lines. Add (TMP);
Idpop31.retrieve (i,idmessage1);
TMP:= idmessage1.body.Text;
Mailzeug.lines. Add (TMP);
if (IdMessage1.MessageParts.Items[i] is TIdAttachment) then
begin
TIdAttachment(IdMessage1.MessageParts.Items[i]).SaveToFile(TIdAttachment(IdMessage1.MessageParts.Items[I]).Filename);
end;
end;
Idpop31.disconnect;
end;
You are using the wrong index value with the IdMessage1.MessageParts.Items[] property, that is why you are getting an "out of range" error. You are using the email's (1-based) index within the mailbox as-if it were a (0-based) attachment index within the email.
You need a 2nd loop to iterate the MessageParts collection of each email that is downloaded, eg:
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
IdSSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
BodyText: string;
MailCount : integer;
part: TIdMessagePart;
begin
IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
IdPOP31.IOHandler := IdSSLIOHandlerSocket;
IdPOP31.Host := 'pop.gmail.com';
IdPOP31.Port := 995;
IdPOP31.UseTLS := utUseImplicitTLS;
IdPOP31.Username := 'name#gmail.com';
IdPOP31.Password := 'xxxxx';
IdPOP31.Connect;
try
MailCount := IdPOP31.CheckMessages;
for i := 1 to MailCount do
begin
IdMessage1.Clear;
IdPOP31.Retrieve(i, IdMessage1);
Mailzeug.Lines.Add(IdMessage1.Subject);
BodyText := IdMessage1.Body.Text;
Mailzeug.Lines.Add(BodyText);
for j := 0 to IdMessage1.MessagePart.Count-1 do
begin
part := IdMessage1.MessageParts.Items[j];
if (part is TIdAttachment) then
begin
TIdAttachment(part).SaveToFile(TIdAttachment(part).Filename);
end;
end;
end;
finally
IdPOP31.Disconnect;
end;
end;
I have X (more than 1) comboboxes declared on a form. (Designtime)
All these comboboxes have the same properties (except position, handle, and a few others they can't share)
I would to give them all the same behavior during runtime, which means if e.g. I add/delete an item or change the ItemIndex or stuff like that, then all comboboxes should do the same.
How can I "clone" all properties/events/etc. from one component at runtime to X other components without doing an operation over and over again for each component?
You can use ReadComponent and WriteComponent from TStream too.
procedure TForm1.Button1Click(Sender: TObject);
var
oStream: TMemoryStream;
i: integer;
cbCombos: array[0..4] of TComboBox;
begin
oStream := TMemoryStream.Create;
ComboBox1.Tag := '666'; { \m/ }
try
oStream.WriteComponent(ComboBox1);
for i := 0 to 4 do
begin
cbCombos[i] := TComboBox.CreateParented(Self.Handle);
oStream.Position := 0;
oStream.ReadComponent(cbCombos[i]);
cbCombos[i].Name := 'AnotherComboBox' + IntToStr(i+1);
cbCombos[i].Parent := Self;
cbCombos[i].Tag := cbCombos[i].Tag + i + 1;
cbCombos[i].Left := 16;
cbCombos[i].Top := 36 * (i + 2);
cbCombos[i].OnMouseEnter := ComboBox1MouseEnter;
end;
finally
FreeAndNil(oStream);
end;
end;
procedure TForm1.ComboBox1MouseEnter(Sender: TObject);
begin
TWinControl(Sender).Hint := IntToStr(TWinControl(Sender).Tag);
end;
You can do that via Extended RTTI
This is a start - by no means complete:
procedure TForm62.CloneComponent(const aSource, aDestination: TComponent);
var
ctx: TRttiContext;
RttiType, DestType: TRttiType;
RttiProperty: TRttiProperty;
Buffer: TStringlist;
begin
if aSource.ClassType <> aDestination.ClassType then
raise Exception.Create('Source and destiantion must be the same class');
Buffer := TStringlist.Create;
try
Buffer.Sorted := True;
Buffer.Add('Name');
Buffer.Add('Handle');
RttiType := ctx.GetType(aSource.ClassType);
DestType := ctx.GetType(aDestination.ClassType);
for RttiProperty in RttiType.GetProperties do
begin
if not RttiProperty.IsWritable then
continue;
if Buffer.IndexOf(RttiProperty.Name) >= 0 then
continue;
DestType.GetProperty(RttiProperty.Name).SetValue(aDestination, RttiProperty.GetValue(aSource));
end;
finally
Buffer.Free;
end;
end;
Could someone know / give me an example of how to read a section from an ini file into a stringGrid? As I am struggling to figure out how to do it.
thanks
Colin
You are better to use TValueListEditor to show a section of an ini-file.
Here is a simple demo code:
procedure TForm1.Button1Click(Sender: TObject);
var
SL: TStrings;
IniFile: TMemIniFile;
begin
SL:= TStringList.Create;
try
IniFile:= TMemIniFile.Create('test.ini');
try
IniFile.ReadSectionValues('FOLDERS', SL);
ValueListEditor1.Strings.Assign(SL);
finally
IniFile.Free;
end;
finally
SL.Free;
end;
end;
OTOMH:
procedure ReadIntoGrid(const aIniFileName, aSection: string; const aGrid: TStringGrid);
var
Ini: TIniFile;
SL: TStringList;
i: Integer;
begin
SL := TStringList.Create;
try
Ini := TIniFile.Create(aIniFileName);
try
aGrid.ColCount := 2;
Ini.ReadSectionValues(aSection, SL);
aGrid.RowCount := SL.Count;
for i := 0 to SL.Count - 1 do
begin
aGrid.Cells[0,i] := SL.Names[i];
aGrid.Cells[1,i] := SL.ValueFromIndex[i];
end;
finally
Ini.Free;
end;
finally
SL.Free;
end;
end;
EDIT
The other way round:
procedure SaveFromGrid(const aIniFileName, aSection: string; const aGrid: TStringGrid);
var
Ini: TIniFile;
i: Integer;
begin
Ini := TIniFile.Create(aIniFileName);
try
for i := 0 to aGrid.RowCount - 1 do
Ini.WriteString(aSection, aGrid.Cells[0,i], aGrid.Cells[1,i]);
finally
Ini.Free;
end;
end;
I use this code with TCheckListbox (lbServices) and it works fine. But with TcxCheckListBox from Devexpress it raise exception.
procedure TMaintenanceForm.AfterConstruction;
var
i: Integer;
ActionObj: TAction;
begin
inherited;
for i := 0 to ServiceActionList.ActionCount-1 do
begin
ActionObj := ServiceActionList.Actions[i] as TAction;
lbServices.Items.AddObject(ActionObj.Caption, ActionObj);
end;
end;
procedure TMaintenanceForm.btnStopClick(Sender: TObject);
begin
fContinue := False;
end;
procedure TMaintenanceForm.cmdExecuteSelectedClick(Sender: TObject);
var
i: Integer;
begin
Screen.Cursor := crHourGlass;
try
for i := 0 to lbServices.Count -1 do
if lbServices.Selected[i] then
(lbServices.Items.Objects[i] as TAction).Execute; // Exception here!!!!
finally
Screen.Cursor := crDefault;
end;
end;
If I debug the code lbServices.Count = 12.
lbServices.Items.Objects[i] is nil for all items in the list. What is wrong here ?
Use the following code instead:
var
AItem: TcxCheckListBoxItem;
begin
AItem := cxCheckListBox1.Items.Add;
AItem.ItemObject := Action1;
AItem.Text := Action1.Caption;
end;
...
var
I: Integer;
begin
for I := 0 to cxCheckListBox1.Items.Count - 1 do
if cxCheckListBox1.Items[I].Checked then
(cxCheckListBox1.Items[I].ItemObject as TACtion).Execute;
end;
There is no Objects property of TcxCheckListBox.Items
How can I get all installed components in TStrings?
I think this code work only within packages:
uses TypInfo, ToolIntf, Exptintf;
procedure GetComponentNames(lst: TStrings);
var
i, k: Integer;
CRef: TClass;
strName: ShortString;
begin
lst.Clear;
for i := 0 to ToolServices.GetModuleCount-1 do
begin
for k := 0 to ToolServices.GetComponentCount(i)-1 do
begin
CRef := TClass(GetClass(ToolServices.GetComponentName(i, k)));
while CRef <> nil do
begin
strName := CRef.ClassName;
if lst.IndexOf(strName) = -1 then
lst.Add(strName);
if str <> 'TComponent' then
CRef := CRef.ClassParent
else
CRef := nil;
end;
end;
end;
end;
Or:
uses ToolsApi;
{....}
var
a, i: Integer;
begin
with (BorlandIDEServices as IOTAPackageServices) do
begin
for a := 0 to GetPackageCount - 1 do
begin
for i := 0 to GetComponentCount(a) - 1 do
begin
{get each component name with GetComponentName(a, i);}
// DoSomething
end;
end;
end;
end;
Thanks for help.
This example doesn't use the OpenAPI, it uses the Registry. It works but it also lists non-visual components amongst other hidden items.
procedure GetComponentNames(lst: TStrings);
var
i, j, iPos: Integer;
Reg: TRegistry;
sComponent: String;
slValues, slData: TStrings;
begin
Reg := TRegistry.Create;
slValues := TStringList.Create;
slData := TStringList.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('Software\Borland\Delphi\6.0\Palette', False); // Change reg key where appropriate
Reg.GetValueNames(slValues);
for i := 0 to Pred(slValues.Count) do
begin
lst.Append(slValues[i]);
lst.Append('----------');
slData.Delimiter := ';';
slData.DelimitedText := Reg.ReadString(slValues[i]);
for j := 0 to Pred(slData.Count) do
begin
sComponent := slData[j];
iPos := Pos('.', sComponent);
if (iPos > 0) then
Delete(sComponent, 1, iPos);
lst.Append(sComponent);
end;
end;
finally
slData.Free;
slValues.Free;
Reg.Free;
end; {try..finally}
end;
I'm not saying this is ideal but it does give you a list and a headstart.