Search Results

Search found 4237 results on 170 pages for 'delphi 2009'.

Page 29/170 | < Previous Page | 25 26 27 28 29 30 31 32 33 34 35 36  | Next Page >

  • Delphi 2010 - Decode Base64 encoded image from XML doc

    - by James
    I am trying to decode a base64 encoded EMF image from an XML document in my application and render it on screen, however, it never seems to appear. If I copy/paste the data from the XML document into Notepad++ and use the Base64 Decode option and save the file as a .emf it opens fine in mspaint. So I think the issue is how I am decoding it. I have tried the following decode methods described in these articles: How to encode / decode Base 64 string http://www.swissdelphicenter.ch/torry/showcode.php?id=1223 I have also tried the TIdDecoderMIME class to no avail. Does anyone know the most reliable way of decoding a base64 encoded string from XML?

    Read the article

  • Delphi: how to create Firebird database programmatically

    - by Brad
    I'm using D2K9, Zeos 7Alpha, and Firebird 2.1 I had this working before I added the autoinc field. Although I'm not sure I was doing it 100% correctly. I don' know what order to do the SQL code, with the triggers, Generators, etc.. I've tried several combinations, I'm guessing I'm doing something wrong other than just that for this not to work. SQL File From IB Expert : /********************************************/ /* Generated by IBExpert 5/4/2010 3:59:48 PM / /*********************************************/ /********************************************/ /* Following SET SQL DIALECT is just for the Database Comparer / /*********************************************/ SET SQL DIALECT 3; /********************************************/ /* Tables / /*********************************************/ CREATE GENERATOR GEN_EMAIL_ACCOUNTS_ID; CREATE TABLE EMAIL_ACCOUNTS ( ID INTEGER NOT NULL, FNAME VARCHAR(35), LNAME VARCHAR(35), ADDRESS VARCHAR(100), CITY VARCHAR(35), STATE VARCHAR(35), ZIPCODE VARCHAR(20), BDAY DATE, PHONE VARCHAR(20), UNAME VARCHAR(255), PASS VARCHAR(20), EMAIL VARCHAR(255), CREATEDDATE DATE, "ACTIVE" BOOLEAN DEFAULT 0 NOT NULL /* BOOLEAN = SMALLINT CHECK (value is null or value in (0, 1)) /, BANNED BOOLEAN DEFAULT 0 NOT NULL / BOOLEAN = SMALLINT CHECK (value is null or value in (0, 1)) /, "PUBLIC" BOOLEAN DEFAULT 0 NOT NULL / BOOLEAN = SMALLINT CHECK (value is null or value in (0, 1)) */, NOTES BLOB SUB_TYPE 0 SEGMENT SIZE 1024 ); /********************************************/ /* Primary Keys / /*********************************************/ ALTER TABLE EMAIL_ACCOUNTS ADD PRIMARY KEY (ID); /********************************************/ /* Triggers / /*********************************************/ SET TERM ^ ; /********************************************/ /* Triggers for tables / /*********************************************/ /* Trigger: EMAIL_ACCOUNTS_BI */ CREATE OR ALTER TRIGGER EMAIL_ACCOUNTS_BI FOR EMAIL_ACCOUNTS ACTIVE BEFORE INSERT POSITION 0 AS BEGIN IF (NEW.ID IS NULL) THEN NEW.ID = GEN_ID(GEN_EMAIL_ACCOUNTS_ID,1); END ^ SET TERM ; ^ /********************************************/ /* Privileges / /*********************************************/ Triggers: /********************************************/ /* Following SET SQL DIALECT is just for the Database Comparer / /*********************************************/ SET SQL DIALECT 3; CREATE GENERATOR GEN_EMAIL_ACCOUNTS_ID; SET TERM ^ ; CREATE OR ALTER TRIGGER EMAIL_ACCOUNTS_BI FOR EMAIL_ACCOUNTS ACTIVE BEFORE INSERT POSITION 0 AS BEGIN IF (NEW.ID IS NULL) THEN NEW.ID = GEN_ID(GEN_EMAIL_ACCOUNTS_ID,1); END ^ SET TERM ; ^ Generators: CREATE SEQUENCE GEN_EMAIL_ACCOUNTS_ID; ALTER SEQUENCE GEN_EMAIL_ACCOUNTS_ID RESTART WITH 2; /* Old syntax is: CREATE GENERATOR GEN_EMAIL_ACCOUNTS_ID; SET GENERATOR GEN_EMAIL_ACCOUNTS_ID TO 2; */ My Code: procedure TForm2.New1Click(Sender: TObject); var query:string; begin if JvOpenDialog1.Execute then begin ZConnection1.Disconnect; ZConnection1.Database:= jvOpenDialog1.FileName; if not FileExists(ZConnection1.database) then begin ZConnection1.Properties.Add('createnewdatabase=create database '''+ZConnection1.Database+''' user ''sysdba'' password ''masterkey'' page_size 4096 default character set iso8859_2;'); try ZConnection1.Connect; except ShowMessage('Error Connection To Database File'); application.Terminate; end; end else begin ShowMessage('Database File Already Exists.'); exit; end; end; query := 'CREATE DOMAIN BOOLEAN AS SMALLINT CHECK (value is null or value in (0, 1))'; Zconnection1.ExecuteDirect(query); query:='CREATE TABLE EMAIL_ACCOUNTS (ID INTEGER NOT NULL,FNAME VARCHAR(35),LNAME VARCHAR(35),'+ 'ADDRESS VARCHAR(100), CITY VARCHAR(35), STATE VARCHAR(35), ZIPCODE VARCHAR(20),' + 'BDAY DATE, PHONE VARCHAR(20), UNAME VARCHAR(255), PASS VARCHAR(20),' + 'EMAIL VARCHAR(255),CREATEDDATE DATE , '+ '"ACTIVE" BOOLEAN DEFAULT 0 NOT NULL,'+ 'BANNED BOOLEAN DEFAULT 0 NOT NULL,'+ '"PUBLIC" BOOLEAN DEFAULT 0 NOT NULL,' + 'NOTES BLOB SUB_TYPE 0 SEGMENT SIZE 1024)'; //ZConnection.ExecuteDirect('CREATE TABLE NOTES (noteTitle TEXT PRIMARY KEY,noteDate DATE,noteNote TEXT)'); Zconnection1.ExecuteDirect(query); { } query := 'CREATE SEQUENCE GEN_EMAIL_ACCOUNTS_ID;'+ 'ALTER SEQUENCE GEN_EMAIL_ACCOUNTS_ID RESTART WITH 1'; Zconnection1.ExecuteDirect(query); query := 'ALTER TABLE EMAIL_ACCOUNTS ADD PRIMARY KEY (ID)'; Zconnection1.ExecuteDirect(query); query := 'SET TERM ^'; Zconnection1.ExecuteDirect(query); query := 'CREATE OR ALTER TRIGGER EMAIL_ACCOUNTS_BI FOR EMAIL_ACCOUNTS'+ 'ACTIVE BEFORE INSERT POSITION 0'+ 'AS'+ 'BEGIN'+ 'IF (NEW.ID IS NULL) THEN'+ 'NEW.ID = GEN_ID(GEN_EMAIL_ACCOUNTS_ID,1);'+ 'END'+ '^'+ 'SET TERM ; ^'; Zconnection1.ExecuteDirect(query); ZTable1.Active:=true; end;

    Read the article

  • Delphi 2010 Error Insight incorrectly flags "Undeclared Identifier"

    - by user257188
    In D2010, Error Insight is incorrectly underlining in red types like "TOpenDialog" (even though my unit and project's uses both include Dialogs). Also, in my method TMyFrame.Foo, it fails the same way by flagging a reference to a VCL component in my TMyFrame -- even though Foo and the component are both part of TMyFrame. SO suggested I read several threads on this subject. One mentions a D2009 fix for this. Is there a D2010 fix? Other postings have suggested that Error Insight yields too many false alarms and should just be turned off. Any suggestions?

    Read the article

  • delphi Ado (mdb) update records

    - by ml
    I´m trying to copy data from one master table and 2 more child tables when i select one record in the master table i copy all the fields from that table for the other (table1 copy from ADOQuery the selected record) procedure TForm1.copyButton7Click(Sender: TObject); SQL.Clear; SQL.Add('SELECT * from ADOQuery'); SQL.Add('Where numeracao LIKE ''%'+NInterv.text);// locate record selected in Table1 NInterv.text) Open; // initiate copy of records begin while not tableADoquery.Eof do begin Table1.Last; Table1.Append;// how to append if necessary! Table1.Edit; Table1.FieldByName('C').Value := ADoquery.FieldByName('C').Value; Table1.FieldByName('client').Value := ADoquery.FieldByName('client').Value; Table1.FieldByName('Cnpj_cpf').Value := ADoquery.FieldByName('Cnpj_cpf').Value; table1.Post; table2.next;/// end; end; //How can i update the TableChield, TableChield1 field´s at the same time? do the same for the child tables TableChield <= TableChield_1 TableChield1 <= TableChield_2 thanks

    Read the article

  • Delphi: problem with httpcli (ICS) post method

    - by www.yegorov-p.ru
    Hello I am using HttpCli component form ICS to POST a request. I use an example that comes with the component. It says: procedure TForm4.Button2Click(Sender: TObject); var Data : String; begin Data:='status=no'; HttpCli1.SendStream := TMemoryStream.Create; HttpCli1.SendStream.Write(Data[1], Length(Data)); HttpCli1.SendStream.Seek(0, 0); HttpCli1.RcvdStream := TMemoryStream.Create; HttpCli1.URL := Trim('http://server/something'); HttpCli1.PostAsync; end; But it fact, it sends not status=no but s.t.a.t.u I can't understand, where is the problem. Maybe someone can show an example, how to send POST request with the help of HttpCli component? PS I can't use Indy =)

    Read the article

  • Delphi - restore actual row in DBGrid

    - by durumdara
    Hi! D6 prof. Formerly we used DBISAM and DBISAMTable. That handle the RecNo, and it is working good with modifications (Delete, edit, etc). Now we replaced with ElevateDB, that don't handle RecNo, and many times we use Queries, not Tables. Query must reopen to see the modifications. But if we Reopen the Query, we need to repositioning to the last record. Locate isn't enough, because Grid is show it in another Row. This is very disturbing thing, because after the modification record is moving into another row, you hard to follow it, and users hate this. We found this code: function TBaseDBGrid.GetActRow: integer; begin Result := -1 + Row; end; procedure TBasepDBGrid.SetActRow(aRow: integer); var bm : TBookMark; begin if IsDataSourceValid(DataSource) then with DataSource.DataSet do begin bm := GetBookmark; DisableControls; try MoveBy(-aRow); MoveBy(aRow); //GotoBookmark(bm); finally FreebookMark(bm); EnableControls; end; end; end; The original example is uses moveby. This working good with Queries, because we cannot see that Query reopened in the background, the visual control is not changed the row position. But when we have EDBTable, or Live/Sensitive Query, the MoveBy is dangerous to use, because if somebody delete or append a new row, we can relocate into wrong record. Then I tried to use the BookMark (see remark). But this technique isn't working, because it is show the record in another Row position... So the question: how to force both the row position and record in DBGrid? Or what kind of DBGrid can relocate to the record/row after the underlying DataSet refreshed? I search for user friendly solution, I understand them, because I tried to use this jump-across DBGrid, and very bad to use, because my eyes are getting out when try to find the original record after update... :-( Thanks for your every help, link, info: dd

    Read the article

  • dUnit Testing in Delphi (how to test private methods)

    - by Charles Faiga
    I have a class that I am unit testing into with dUnit It has a number of methods some public Methods & Private Methods type TAuth = class(TDataModule) private procedure PrivateMethod; public procedure PublicMethod; end; In order to write a unit test for this class I have to make all the methods public. Is there a differt way to declare the PrivateMethods so that I can still unit test them but they are not Public ?

    Read the article

  • Registry ReadString method is not working in Windows 7 in Delphi 7

    - by Tofig Hasanov
    The following code sample used to return me windows id before, but now it doesn't work, and returns empty string, dunno why. function GetWindowsID: string; var Registry: TRegistry; str:string; begin Registry := TRegistry.Create(KEY_WRITE); try Registry.Lazywrite := false; Registry.RootKey := HKEY_LOCAL_MACHINE; // Registry.RootKey := HKEY_CURRENT_USER; if CheckForWinNT = true then Begin if not Registry.OpenKeyReadOnly('\Software\Microsoft\Windows NT\CurrentVersion') then showmessagE('cant open'); end else Registry.OpenKeyReadOnly('\Software\Microsoft\Windows\CurrentVersion'); str := Registry.ReadString('ProductId'); result:=str; Registry.CloseKey; finally Registry.Free; end; // try..finally end; Anybody can help?

    Read the article

  • create a wav file from multiple wav files in delphi

    - by Bayu
    i' ve a problem in doing my final project... i'm having trouble with how to save multiple wav files into 1 wav file.. let's take an example: i have 3 wav files which are the syllables of the word "hospital" : "hos.wav", "pi.wav", and "tal.wav" (sorry if i'm wrong in determining the syllables of the words).. each of those syllable wav files contains utterances of the syllables of the word "hospital" respectively.. my task is to merge those files so that the word hospital could be reproduced from those files. and then to save the merged file to be a new wav file, let say "hospital.wav"..I've done my first task, but not with my second task... does anyone can help me? thx b4..

    Read the article

  • Delphi: RTTI and TObjectList<TObject>

    - by conciliator
    Based on one answer to an earlier post, I'm investigating the possibility of the following design TChildClass = class(TObject) private FField1: string; FField2: string; end; TMyClass = class(TObject) private FField1: TChildClass; FField2: TObjectList<TChildClass>; end; Now, in the real world, TMyClass will have 10 different lists like this, so I would like to be able to address these lists using RTTI. However, I'm not interested in the other fields of this class, so I need to check if a certain field is some sort of TObjectList. This is what I've got so far: procedure InitializeClass(RContext: TRttiContext; AObject: TObject); var ROwnerType: TRttiType; RObjListType: TRttiType; RField: TRttiField; SchInf: TSchemaInfoDetail; begin ROwnerType := RContext.GetType(AObject.ClassInfo); RObjListType := RContext.GetType(TObjectList<TObject>); for RField in ROwnerType.GetFields do begin // How do I check if the type of TMyClass.FField2 (which is TObjectList<TChildClass>) is some sort of TObjectList? end; Clearly, RField.FieldType <> RObjListType.FieldType. However, they do have some relation, don't they? It seems horrible (and wrong!) to make a very elaborate check for common functionality in order to make it highly probable that RField.FieldType is in fact a TObjectList. To be honest, I am quite uncomfortable with generics, so the question might be very naïve. However, I'm more than happy to learn. Is the above solution possible to implement? TIA!

    Read the article

  • How to delete specific node in omnixml delphi

    - by Erwan
    i've read this answer but i don't know how to use that sample in my case. I have an xml file <Archive> <Source> <Name>321</Name> <BatchID>123</BatchID> </Source> <DataList> <Data> <PN>AAAA</PN> <FN>1111</FN> </Data> <Data> <PN>BBBB</PN> <FN>2222</FN> </Data> </DataList> </Archive> How can i delete the Node that has PN=BBBB? I'm so sorry, i think i'm not clear in my question, my bad, My Question is how to delete this section: <Data> <PN>BBBB</PN> <FN>2222</FN> </Data> not only this section <PN>BBBB</PN> The Answer: Thanks to Runner, i modified a little bit of his code DeleteNode := XMLDoc.DocumentElement.SelectSingleNode('/Archive/DataList/Data[PN="BBBB"]'); DeleteNode.ParentNode.RemoveChild(DeleteNode);

    Read the article

  • Delphi and prevent event handling

    - by pKarelian
    How do you prevent a new event handling to start when an event handling is already running? I press a button1 and event handler start e.g. slow printing job. There are several controls in form buttons, edits, combos and I want that a new event allowed only after running handler is finnished. I have used fRunning variable to lock handler in shared event handler. Is there more clever way to handle this? procedure TFormFoo.Button_Click(Sender: TObject); begin if not fRunning then try fRunning := true; if (Sender = Button1) then // Call something slow ... if (Sender = Button2) then // Call something ... if (Sender = Button3) then // Call something ... finally fRunning := false; end; end;

    Read the article

  • Delphi: Why does IdHTTP.ConnectTimeout make requests slower?

    - by K.Sandell
    I discovered that when setting the ConnectTimeoout property for a TIdHTTP component, it makes the requests (GET and POST) become about 120ms slower? Why is this, and can I avoid/bypass this somehow? Env: D2010 with shipped Indy components, all updates installed for D2010. OS is WinXP (32bit) SP3 with most patches... My timing routine is: Procedure DoGet; Var Freq,T1,T2 : Int64; Cli : TIdHTTP; S : String; begin QueryPerformanceFrequency(Freq); Try QueryPerformanceCounter(T1); Cli := TIdHTTP.Create( NIL ); Cli.ConnectTimeout := 1000; // without this we get < 15ms!! S := Cli.Get('http://127.0.0.1/empty_page.php'); Finally FreeAndNil(Cli); QueryPerformanceCounter(T2); End; Memo1.Lines.Add('Time = '+FormatFloat('0.000',(T2-T1)/Freq) ); End; With the ConnectTimeout set in code I get avg. times of 130-140ms, without it's about 5-15ms ...

    Read the article

  • delphi insert update record´s

    - by ml
    Hi friends what is that im doing wrong because it goes and goes on LOOP var ii: Integer; i: Integer; j: Integer; ie : integer; je : integer; fileSource, fileDest: string; Fo : TSHFileOpStruct; buffer : array[0..4096] of char; p : pchar; dirFile: String; dirFile1: String; dirFile11: String; begin dirFile1 := (Dirlocal + 'Vibrometria\'+ClienteN.text+'\'); dirFile := (localAplicação+ 'Vibrometria\'+ClienteN.text+'\'+NInterv.text ) ; dirFile11:= Dirlocal+'Vibrometria\'; if ForceDirectories(dirFile11) then if ForceDirectories(dirFile1) then //...................................................................... begin ShowMessage('Vai devolver "'+cxDBTextEdit5.Text+'..........' +obra.Text); Sub_TRelFinal.First; Begin ADOTable_casa.First; Begin begin Sub_TRelFinal.Edit; //Tabela1Codoco.Value := Tabela2Codoco.Value; Sub_TRelFinal.FieldByName('Foto1').text := ADOTable_casa.FieldByName('Foto1').text; Sub_TRelFinal.FieldByName('Obra').text := ADOTable_casa.FieldByName('Obra').text; Sub_TRelFinal.FieldByName('OBS1').text := ADOTable_casa.FieldByName('OBS1').text; Sub_TRelFinal.FieldByName('Data_VisitaLocal').text := ADOTable_casa.FieldByName('Data_VisitaLocal').text; Sub_TRelFinal.FieldByName('ContractoN').text := ADOTable_casa .FieldByName('ContractoN').text;; Sub_TRelFinal.FieldByName('Cliente').text := ADOTable_casa .FieldByName('Cliente').text; Sub_TRelFinal.FieldByName('Morada').text := ADOTable_casa .FieldByName('Morada').text; Sub_TRelFinal.FieldByName('localizacao').text:= ADOTable_casa .FieldByName('localizacao').text; Sub_TRelFinal.FieldByName('Intruducao').text:= ADOTable_casa .FieldByName('Intruducao').text; Sub_TRelFinal.FieldByName('Analise').text := ADOTable_casa.FieldByName('Analise').text; Sub_TRelFinal.Post; end; End; end; //iniciar inserção registos sub Sub_TRelFinal_1.First; For j := 1 to Sub_TRelFinal_1.RecordCount do Begin ADOTable_casa_sub_1.First; For i := 1 To ADOTable_casa_sub_1.RecordCount Do Begin begin Sub_TRelFinal_1.Edit; //Tabela1Codoco.Value := Tabela2Codoco.Value; Sub_TRelFinal_1.FieldByName('Foto1').text := ADOTable_casa_sub_1.FieldByName('Foto1').text; Sub_TRelFinal_1.FieldByName('Obra').text := ADOTable_casa_sub_1.FieldByName('Obra').text; Sub_TRelFinal_1.FieldByName('OBS1').text := ADOTable_casa_sub_1.FieldByName('OBS1').text; Sub_TRelFinal_1.FieldByName('Data_VisitaLocal').text := ADOTable_casa_sub_1.FieldByName('Data_VisitaLocal').text; Sub_TRelFinal_1.FieldByName('ContractoN').text := ADOTable_casa_sub_1.FieldByName('ContractoN').text; Sub_TRelFinal_1.FieldByName('Cliente').text := ADOTable_casa_sub_1.FieldByName('Cliente').text; Sub_TRelFinal_1.FieldByName('Morada').text := ADOTable_casa_sub_1.FieldByName('Morada').text; Sub_TRelFinal_1.FieldByName('localizacao_eq').text:= ADOTable_casa_sub_1.FieldByName('localizacao_eq').text; Sub_TRelFinal_1.FieldByName('Equipamento').text:= ADOTable_casa_sub_1.FieldByName('Equipamento').text; Sub_TRelFinal_1.FieldByName('tipo_equip').text := ADOTable_casa_sub_1.FieldByName('tipo_equip').text; Sub_TRelFinal_1.Post; end; //iniciar inserção registos subsub SubTRelFinal_sub.First; For ie := 1 to SubTRelFinal_sub.RecordCount do Begin ADOTable_casa_sub_Sub.First; For je := 1 To ADOTable_casa_sub_Sub.RecordCount Do begin SubTRelFinal_sub.Edit; //Tabela1Codoco.Value := Tabela2Codoco.Value; SubTRelFinal_sub.FieldByName('Foto1').text := ADOTable_casa_sub_Sub.FieldByName('Foto1').text; SubTRelFinal_sub.FieldByName('Foto2').text := ADOTable_casa_sub_Sub.FieldByName('Foto2').text; SubTRelFinal_sub.FieldByName('Analisefoto1').text := ADOTable_casa_sub_Sub.FieldByName('Analisefoto1').text; SubTRelFinal_sub.FieldByName('Observações').text := ADOTable_casa_sub_Sub.FieldByName('Observações').text;; SubTRelFinal_sub.FieldByName('ContractoN').text := ADOTable_casa_sub_Sub.FieldByName('ContractoN').text; SubTRelFinal_sub.FieldByName('OBS3').text := ADOTable_casa_sub_Sub.FieldByName('OBS3').text; SubTRelFinal_sub.FieldByName('OBS4').text := ADOTable_casa_sub_Sub.FieldByName('OBS4').text; SubTRelFinal_sub.FieldByName('OBS2').text := ADOTable_casa_sub_Sub.FieldByName('OBS2').text; SubTRelFinal_sub.FieldByName('OBS1').text := ADOTable_casa_sub_Sub.FieldByName('OBS1').text; SubTRelFinal_sub.FieldByName('Localização').text := ADOTable_casa_sub_Sub.FieldByName('Localização').text; SubTRelFinal_sub.FieldByName('Tipo_equipamento').text:= ADOTable_casa_sub_Sub.FieldByName('Tipo_equipamento').text; SubTRelFinal_sub.FieldByName('Analisefoto101').text:= ADOTable_casa_sub_Sub.FieldByName('Analisefoto101').text; SubTRelFinal_sub.FieldByName('Analisefoto201').text := ADOTable_casa_sub_Sub.FieldByName('Analisefoto201').text; SubTRelFinal_sub.FieldByName('GrauAnomalia').text := ADOTable_casa_sub_Sub.FieldByName('GrauAnomalia').text; SubTRelFinal_sub.Post; end; ADOTable_casa_sub_Sub.Next; End; SubTRelFinal_sub.Next; End; ADOTable_casa_sub_1.Next; End; Sub_TRelFinal_1 .Next;

    Read the article

  • Interface Marshalling in Delphi

    - by cemick
    I want to send Interface Ref of IVApplication from Visio Add-in to my other one COM server. But I have Ole exception. Now i do that: Code in Visio Add-in: var IStrm: IStream; hres: HResult; rhglobal: HGLOBAL; VisioAppl: IVApplication; begin hres := CreateStreamOnHGlobal(0, TRUE, IStrm); if Succeeded(hres) then hres := CoMarshalInterface(IStrm, IID_IVApplication, VisioAppl, MSHCTX_LOCAL, 0, MSHLFLAGS_NORMAL); if (Succeeded(hres)) then begin hres := GetHGlobalFromStream(IStrm, rhglobal); IStrm := nil; end; end; After this I create instance of my COM server and pass rhglobal to him. Code of my COM server: procedure (AHGlobal: HGlobal); var VisioAppl: Visio_TLB.IVApplication; iStrm: IStream; hres: HResult; begin iStrm := Nil; VisioAppl:= nil; hres := CreateStreamOnHGlobal(AHGlobal, FALSE, iStrm); if (SUCCEEDED(hres)) then begin hres := CoUnmarshalInterface(iStrm, Visio_TLB.IVApplication, VisioAppl); iStrm := nil; ShowMessage('Result:' + BoolToStr(SUCCEEDED(hres))); <-- result 0 ShowMessage(VisioAppl.ProductName); <---- Error end; end;

    Read the article

  • Parsing a string using a delimiter to a TStringList, seems to also parse on spaces (Delphi)

    - by Daisetsu
    I have a simple string which is delimited by some character, let's say a comma. I should be able to create a TStringList and set it's delimiter to a comma then set the DelimitedText to the text I want to parse and it should be automaticlly parsed. The problem is when I look at the output it also includes spaces as delimiters and chops up my results. How can I avoid this, or is there a better way to do this.

    Read the article

  • Quickest way to find the oldest file in a directory using Delphi

    - by Pieter van Wyk
    HI We have a large number of remote computers that capture video onto disk drives. Each camera has it's own unique directory and there can be up to 16 directories on any one disk. I'm trying to locate the oldest video file on the disk but using FindFirst/FindNext to compare the File Creation DateTime takes forever. Does anybody know of a more efficient way of finding the oldest file in a directory? We remotely connect to the pc's from a central HO location. Regards, Pieter

    Read the article

  • Delphi threads deadlock

    - by Lobuno
    Hello! I am having a problem sometimes with a deadlock when destroying some threads. I've tried to debug the problem but the deadlock never seems to exist when debugging in the IDE, perhaps because of the low speed of the events in the ide. The problem: The main thread creates several threads when the application starts. The threads are always alive and synchronizing with the main thread. No problems at all. The threads are destroyed when the applcation ends (mainform.onclose) like this: thread1.terminate; thread1.waitfor; thread1.free; and so on. but some times one of the threads (which logs some string to a memo, using synchronize) will lock the whole application when closing. I suspect that the thread is synchronizing when I call waitform and the harmaggeddon happens, but that's is just a guess because the deadlock never happens when debbuging (or I've never been able to reproduce it anyway). Any advice?

    Read the article

  • Delphi Editbox causing unexplainable errors...

    - by NeoNMD
    On a form I have 8 edit boxes that I do the exact same thing with. They are arranged in 2 sets of 4, one is Upper and the other is Lower. I kept getting errors clearing all the edit boxes so I went through clearing them 1 by 1 and found that 1 of the edit boxes just didnt work and when I tried to run the program and change that exit box it caused the debugger to jump to a point in the code with the database (even though the edit boxes had nothing to do with the database and they arent in a procedure or stack with a database in it) and say the program has access violation there. So I then removed all mention of that edit box and the code worked perfectly again, so I deleted that edit box, copied and pasted another edit box and left all values the same, then went through my code and copied the code from the other sections and simply renamed it for the new Edit box and it STILL causes an error even though it is entirely new. I cannot figure it out so I ask you all, what the hell? The editbox in question is "Edit1" unit DefinitionCoreV2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, SQLiteTable3, StdCtrls; type TDefinitionFrm = class(TForm) GrpCompetition: TGroupBox; CmbCompSele: TComboBox; BtnCompetitionAdd: TButton; BtnCompetitionUpdate: TButton; BtnCompetitionRevert: TButton; GrpCompetitionDetails: TGroupBox; LblCompetitionIDTitle: TLabel; EdtCompID: TEdit; LblCompetitionDescriptionTitle: TLabel; EdtCompDesc: TEdit; LblCompetitionNotesTitle: TLabel; EdtCompNote: TEdit; LblCompetitionLocationTitle: TLabel; EdtCompLoca: TEdit; BtnCompetitionDelete: TButton; GrpSection: TGroupBox; LblSectionID: TLabel; LblGender: TLabel; LblAge: TLabel; LblLevel: TLabel; LblWeight: TLabel; LblType: TLabel; LblHeight: TLabel; LblCompetitionID: TLabel; BtnSectionAdd: TButton; EdtSectionID: TEdit; CmbGender: TComboBox; BtnSectionUpdate: TButton; BtnSectionRevert: TButton; CmbAgeRange: TComboBox; CmbLevelRange: TComboBox; CmbType: TComboBox; CmbWeightRange: TComboBox; CmbHeightRange: TComboBox; EdtSectCompetitionID: TEdit; BtnSectionDelete: TButton; GrpSectionDetails: TGroupBox; EdtLowerAge: TEdit; EdtLowerWeight: TEdit; EdtLowerHeight: TEdit; EdtUpperAge: TEdit; EdtUpperLevel: TEdit; EdtUpperWeight: TEdit; EdtUpperHeight: TEdit; LblAgeRule: TLabel; LblLevelRule: TLabel; LblWeightRule: TLabel; LblHeightRule: TLabel; LblCompetitionSelect: TLabel; LblSectionSelect: TLabel; CmbSectSele: TComboBox; Edit1: TEdit; procedure FormCreate(Sender: TObject); procedure BtnCompetitionAddClick(Sender: TObject); procedure CmbCompSeleChange(Sender: TObject); procedure BtnCompetitionUpdateClick(Sender: TObject); procedure BtnCompetitionRevertClick(Sender: TObject); procedure BtnCompetitionDeleteClick(Sender: TObject); procedure CmbSectSeleChange(Sender: TObject); procedure BtnSectionAddClick(Sender: TObject); procedure BtnSectionUpdateClick(Sender: TObject); procedure BtnSectionRevertClick(Sender: TObject); procedure BtnSectionDeleteClick(Sender: TObject); procedure CmbAgeRangeChange(Sender: TObject); procedure CmbLevelRangeChange(Sender: TObject); procedure CmbWeightRangeChange(Sender: TObject); procedure CmbHeightRangeChange(Sender: TObject); private procedure UpdateCmbCompSele; procedure AddComp; procedure RevertComp; procedure AddSect; procedure RevertSect; procedure UpdateCmbSectSele; procedure ClearSect; { Private declarations } public { Public declarations } end; var DefinitionFrm: TDefinitionFrm; implementation {$R *.dfm} procedure TDefinitionFrm.UpdateCmbCompSele; var slDBpath: string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; sCompTitle : string; bNext : boolean; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sltb := slDb.GetTable('SELECT * FROM CompetitionTable'); try CmbCompSele.Items.Clear; Repeat begin sCompTitle:=sltb.FieldAsString(sltb.FieldIndex['CompetitionID'])+':'+sltb.FieldAsString(sltb.FieldIndex['Description']); CmbCompSele.Items.Add(sCompTitle); bNext := sltb.Next; end; Until sltb.EOF; finally sltb.Free; end; finally sldb.Free; end; end; procedure TDefinitionFrm.UpdateCmbSectSele; var slDBpath: string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; sSQL : string; sSectTitle : string; bNext : boolean; bLast : boolean; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sltb := slDb.GetTable('SELECT * FROM SectionTable WHERE CompetitionID = '+EdtCompID.text); If sltb.RowCount =0 then begin sltb := slDb.GetTable('SELECT * FROM SectionTable'); bLast:= sltb.MoveLast; sSQL := 'INSERT INTO SectionTable(SectionID,CompetitionID,Gender,Type) VALUES ('+IntToStr(sltb.FieldAsInteger(sltb.FieldIndex['SectionID'])+1)+','+EdtCompID.text+',1,1)'; sldb.ExecSQL(sSQL); sltb := slDb.GetTable('SELECT * FROM SectionTable WHERE CompetitionID = '+EdtCompID.text); end; try CmbSectSele.Items.Clear; Repeat begin sSectTitle:=sltb.FieldAsString(sltb.FieldIndex['SectionID'])+':'+sltb.FieldAsString(sltb.FieldIndex['Type'])+':'+sltb.FieldAsString(sltb.FieldIndex['Gender'])+':'+sltb.FieldAsString(sltb.FieldIndex['Age'])+':'+sltb.FieldAsString(sltb.FieldIndex['Level'])+':'+sltb.FieldAsString(sltb.FieldIndex['Weight'])+':'+sltb.FieldAsString(sltb.FieldIndex['Height']); CmbSectSele.Items.Add(sSectTitle); //CmbType.Items.Strings[sltb.FieldAsInteger(sltb.FieldIndex['Type'])] Works but has logic errors bNext := sltb.Next; end; Until sltb.EOF; finally sltb.Free; end; finally sldb.Free; end; end; procedure TDefinitionFrm.AddComp; var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; bLast : boolean; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sltb := slDb.GetTable('SELECT * FROM CompetitionTable'); try bLast:= sltb.MoveLast; sSQL := 'INSERT INTO CompetitionTable(CompetitionID,Description) VALUES ('+IntToStr(sltb.FieldAsInteger(sltb.FieldIndex['CompetitionID'])+1)+',"New Competition")'; sldb.ExecSQL(sSQL); finally sltb.Free; end; finally sldb.Free; end; UpdateCmbCompSele; end; procedure TDefinitionFrm.AddSect; var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; bLast : boolean; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sltb := slDb.GetTable('SELECT * FROM SectionTable'); try bLast:= sltb.MoveLast; sSQL := 'INSERT INTO SectionTable(SectionID,CompetitionID,Gender,Type) VALUES ('+IntToStr(sltb.FieldAsInteger(sltb.FieldIndex['SectionID'])+1)+','+EdtCompID.text+',1,1)'; sldb.ExecSQL(sSQL); finally sltb.Free; end; finally sldb.Free; end; UpdateCmbSectSele; end; procedure TDefinitionFrm.RevertComp; var slDBpath: string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; iID : integer; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try If CmbCompSele.Text <> '' then begin iID := StrToInt(Copy(CmbCompSele.Text,0,Pos(':',CmbCompSele.Text)-1)); sltb := slDb.GetTable('SELECT * FROM CompetitionTable WHERE CompetitionID='+IntToStr(iID))//ItemIndex starts at 0, CompID at 1 end else sltb := slDb.GetTable('SELECT * FROM CompetitionTable WHERE CompetitionID=1'); try EdtCompID.Text:=sltb.FieldAsString(sltb.FieldIndex['CompetitionID']); EdtCompLoca.Text:=sltb.FieldAsString(sltb.FieldIndex['Location']); EdtCompDesc.Text:=sltb.FieldAsString(sltb.FieldIndex['Description']); EdtCompNote.Text:=sltb.FieldAsString(sltb.FieldIndex['Notes']); finally sltb.Free; end; finally sldb.Free; end; end; procedure TDefinitionFrm.RevertSect; var slDBpath: string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; iID : integer; sTemp : string; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try If CmbCompSele.Text <> '' then begin iID := StrToInt(Copy(CmbSectSele.Text,0,Pos(':',CmbSectSele.Text)-1)); sltb := slDb.GetTable('SELECT * FROM SectionTable WHERE SectionID='+IntToStr(iID));//ItemIndex starts at 0, CompID at 1 end else sltb := slDb.GetTable('SELECT * FROM SectionTable WHERE CompetitionID='+EdtCompID.Text); try EdtSectionID.Text:=sltb.FieldAsString(sltb.FieldIndex['SectionID']); EdtSectCompetitionID.Text:=sltb.FieldAsString(sltb.FieldIndex['CompetitionID']); Case sltb.FieldAsInteger(sltb.FieldIndex['Type']) of 1 : CmbType.ItemIndex:=0; 2 : CmbType.ItemIndex:=0; 3 : CmbType.ItemIndex:=1; 4 : CmbType.ItemIndex:=1; end; Case sltb.FieldAsInteger(sltb.FieldIndex['Gender']) of 1 : CmbGender.ItemIndex:=0; 2 : CmbGender.ItemIndex:=1; 3 : CmbGender.ItemIndex:=2; end; sTemp := sltb.FieldAsString(sltb.FieldIndex['Age']); if sTemp <> '' then begin //Decode end else begin LblAgeRule.Hide; EdtLowerAge.Text :=''; EdtLowerAge.Hide; EdtUpperAge.Text :=''; EdtUpperAge.Hide; end; sTemp := sltb.FieldAsString(sltb.FieldIndex['Level']); if sTemp <> '' then begin //Decode end else begin LblLevelRule.Hide; Edit1.Text :=''; Edit1.Hide; EdtUpperLevel.Text :=''; EdtUpperLevel.Hide; end; sTemp := sltb.FieldAsString(sltb.FieldIndex['Weight']); if sTemp <> '' then begin //Decode end else begin LblWeightRule.Hide; EdtLowerWeight.Text :=''; EdtLowerWeight.Hide; EdtUpperWeight.Text :=''; EdtUpperWeight.Hide; end; sTemp := sltb.FieldAsString(sltb.FieldIndex['Height']); if sTemp <> '' then begin //Decode end else begin LblHeightRule.Hide; EdtLowerHeight.Text :=''; EdtLowerHeight.Hide; EdtUpperHeight.Text :=''; EdtUpperHeight.Hide; end; finally sltb.Free; end; finally sldb.Free; end; end; procedure TDefinitionFrm.BtnCompetitionAddClick(Sender: TObject); begin AddComp end; procedure TDefinitionFrm.ClearSect; begin CmbSectSele.Clear; EdtSectionID.Text:=''; EdtSectCompetitionID.Text:=''; CmbType.Clear; CmbGender.Clear; CmbAgeRange.Clear; EdtLowerAge.Text:=''; EdtUpperAge.Text:=''; CmbLevelRange.Clear; Edit1.Text:=''; EdtUpperLevel.Text:=''; CmbWeightRange.Clear; EdtLowerWeight.Text:=''; EdtUpperWeight.Text:=''; CmbHeightRange.Clear; EdtLowerHeight.Text:=''; EdtUpperHeight.Text:=''; end; procedure TDefinitionFrm.CmbCompSeleChange(Sender: TObject); begin If CmbCompSele.ItemIndex <> -1 then begin RevertComp; GrpSection.Enabled:=True; CmbSectSele.Clear; ClearSect; UpdateCmbSectSele; end; end; procedure TDefinitionFrm.BtnCompetitionUpdateClick(Sender: TObject); var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sSQL:= 'UPDATE CompetitionTable SET Description="'+EdtCompDesc.Text+'",Location="'+EdtCompLoca.Text+'",Notes="'+EdtCompNote.Text+'" WHERE CompetitionID ="'+EdtCompID.Text+'";'; sldb.ExecSQL(sSQL); finally sldb.Free; end; end; procedure TDefinitionFrm.BtnCompetitionRevertClick(Sender: TObject); begin RevertComp; end; procedure TDefinitionFrm.BtnCompetitionDeleteClick(Sender: TObject); var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; iID : integer; begin If CmbCompSele.Text <> '' then begin If (CmbCompSele.Text[1] ='1') and (CmbCompSele.Text[2] =':') then begin MessageDlg('Deleting the last record is a very bad idea :/',mtInformation,[mbOK],0); end else begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try iID := StrToInt(Copy(CmbCompSele.Text,0,Pos(':',CmbCompSele.Text)-1)); sSQL:= 'DELETE FROM SectionTable WHERE CompetitionID='+IntToStr(iID)+';'; sldb.ExecSQL(sSQL); sSQL:= 'DELETE FROM CompetitionTable WHERE CompetitionID='+IntToStr(iID)+';'; sldb.ExecSQL(sSQL); finally sldb.Free; end; CmbCompSele.ItemIndex:=0; UpdateCmbCompSele; RevertComp; CmbCompSele.Text:='Select Competition'; end; end; end; procedure TDefinitionFrm.FormCreate(Sender: TObject); begin UpdateCmbCompSele; end; procedure TDefinitionFrm.CmbSectSeleChange(Sender: TObject); begin RevertSect; end; procedure TDefinitionFrm.BtnSectionAddClick(Sender: TObject); begin AddSect; end; procedure TDefinitionFrm.BtnSectionUpdateClick(Sender: TObject); //change fields values var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; iTypeCode : integer; iGenderCode : integer; sAgeStr, sLevelStr, sWeightStr, sHeightStr : string; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try If CmbType.Text='Fighting' then iTypeCode := 1 else iTypeCode := 3; If CmbGender.Text='Male' then iGenderCode := 1 else if CmbGender.Text='Female' then iGenderCode := 2 else iGenderCode := 3; Case CmbAgeRange.ItemIndex of 0:sAgeStr := 'o-'+EdtLowerAge.Text; 1:sAgeStr := 'u-'+EdtLowerAge.Text; 2:sAgeStr := EdtLowerAge.Text+'-'+EdtUpperAge.Text; end; Case CmbLevelRange.ItemIndex of 0:sLevelStr := 'o-'+Edit1.Text; 1:sLevelStr := 'u-'+Edit1.Text; 2:sLevelStr := Edit1.Text+'-'+EdtUpperLevel.Text; end; Case CmbWeightRange.ItemIndex of 0:sWeightStr := 'o-'+EdtLowerWeight.Text; 1:sWeightStr := 'u-'+EdtLowerWeight.Text; 2:sWeightStr := EdtLowerWeight.Text+'-'+EdtUpperWeight.Text; end; Case CmbHeightRange.ItemIndex of 0:sHeightStr := 'o-'+EdtLowerHeight.Text; 1:sHeightStr := 'u-'+EdtLowerHeight.Text; 2:sHeightStr := EdtLowerHeight.Text+'-'+EdtUpperHeight.Text; end; sSQL:= 'UPDATE SectionTable SET Type="'+IntToStr(iTypeCode)+'",Gender="'+IntToStr(iGenderCode)+'" WHERE SectionID ="'+EdtSectionID.Text+'";'; sldb.ExecSQL(sSQL); finally sldb.Free; end; end; procedure TDefinitionFrm.BtnSectionRevertClick(Sender: TObject); begin RevertSect; end; procedure TDefinitionFrm.BtnSectionDeleteClick(Sender: TObject); var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; begin If CmbSectSele.Text[1] ='1' then begin MessageDlg('Deleting the last record is a very bad idea :/',mtInformation,[mbOK],0); end else begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sSQL:= 'DELETE FROM SectionTable WHERE SectionID='+CmbSectSele.Text[1]+';'; sldb.ExecSQL(sSQL); finally sldb.Free; end; CmbSectSele.ItemIndex:=0; UpdateCmbSectSele; RevertSect; CmbSectSele.Text:='Select Competition'; end; end; procedure TDefinitionFrm.CmbAgeRangeChange(Sender: TObject); begin Case CmbAgeRange.ItemIndex of 0: begin EdtLowerAge.Show; LblAgeRule.Caption:='Over and including'; LblAgeRule.Show; EdtUpperAge.Hide; end; 1: begin EdtLowerAge.Show; LblAgeRule.Caption:='Under and including'; LblAgeRule.Show; EdtUpperAge.Hide; end; 2: begin EdtLowerAge.Show; LblAgeRule.Caption:='LblAgeRule'; LblAgeRule.Hide; EdtUpperAge.Show; end; end; end; procedure TDefinitionFrm.CmbLevelRangeChange(Sender: TObject); begin Case CmbLevelRange.ItemIndex of 0: begin Edit1.Show; LblLevelRule.Caption:='Over and including'; LblLevelRule.Show; EdtUpperLevel.Hide; end; 1: begin Edit1.Show; LblLevelRule.Caption:='Under and including'; LblLevelRule.Show; EdtUpperLevel.Hide; end; 2: begin Edit1.Show; LblLevelRule.Caption:='LblLevelRule'; LblLevelRule.Hide; EdtUpperLevel.Show; end; end; end; procedure TDefinitionFrm.CmbWeightRangeChange(Sender: TObject); begin Case CmbWeightRange.ItemIndex of 0: begin EdtLowerWeight.Show; LblWeightRule.Caption:='Over and including'; LblWeightRule.Show; EdtUpperWeight.Hide; end; 1: begin EdtLowerWeight.Show; LblWeightRule.Caption:='Under and including'; LblWeightRule.Show; EdtUpperWeight.Hide; end; 2: begin EdtLowerWeight.Show; LblWeightRule.Caption:='LblWeightRule'; LblWeightRule.Hide; EdtUpperWeight.Show; end; end; end; procedure TDefinitionFrm.CmbHeightRangeChange(Sender: TObject); begin Case CmbHeightRange.ItemIndex of 0: begin EdtLowerHeight.Show; LblHeightRule.Caption:='Over and including'; LblHeightRule.Show; EdtUpperHeight.Hide; end; 1: begin EdtLowerHeight.Show; LblHeightRule.Caption:='Under and including'; LblHeightRule.Show; EdtUpperHeight.Hide; end; 2: begin EdtLowerHeight.Show; LblHeightRule.Caption:='LblHeightRule'; LblHeightRule.Hide; EdtUpperHeight.Show; end; end; end; end.

    Read the article

  • Delphi, how to make independent windows

    - by Roy M Klever
    I have an application that uses tabs like the Chrome browser. Now I want to be able to open more forms and not be limited to only one form. These forms should act the same but if I close main form all forms are closed. How can I make all forms be equal, so no matter which form I close it only closes that form and not exit application before all forms are closed? Any ideas? Kind Regards Roy M Klever

    Read the article

  • How retrive full path with file name or folder name in Delphi 2010

    - by Dev
    Sir, I create a project, where I use ShellTreeView, ShellListView, ListView. Now I drag folder from ShellTreeView and files from ShellListView. Now I want to retrieve file name including full path (like: c:\abc\file.txt) or folder (like C:\abc). For retrieving the path I use a command button and a text box. What will the code? Dev

    Read the article

< Previous Page | 25 26 27 28 29 30 31 32 33 34 35 36  | Next Page >