Search Results

Search found 1724 results on 69 pages for 'turbo delphi'.

facebook twitter digg google delicious technorati stumbleupon myspace wordpress linkedin gmail igoogle windows live tumblr viadeo yahoo buzz yahoo mail yahoo bookmarks favorites email print

Page 22/69 | < Previous Page | 18 19 20 21 22 23 24 25 26 27 28 29  | Next Page >

  • 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

  • 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

  • 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

  • Delphi 2010 RTTI : Explore Enumerations

    - by ZeDalaye
    Hi, Considering such an enumeration : type TTypeOfData = ( [XmlName('ABC')] todABC, [XmlName('DEF')] todDEF, [XmlName('GHI')] todGHI ); Where XmlName is a custom attribute used to define the serialization string for members of this enumeration. How can I explore the attributes attached to each member of this enumeration ? Regards, -- Pierre

    Read the article

  • Delphi Unicode String Type Stored Directly at its Address

    - by Andreas Rejbrand
    I want a string type that is Unicode and that stores the string directly at the adress of the variable, as is the case of the (Ansi-only) ShortString type. I mean, if I declare a S: ShortString and let S := 'My String', then, at @S, I will find the length of the string (as one byte, so the string cannot contain more than 255 characters) followed by the ANSI-encoded string itself. What I would like is a Unicode variant of this. That is, I want a string type such that, at @S, I will find a unsigned 32-bit integer containing the length of the string in bytes (or in characters, which is half the number of bytes) followed by the Unicode representation of the string. I have tried WideString, UnicodeString, and RawByteString, but they all appear only to store an adress at @S, and the actual string somewhere else (I guess this has do do with reference counting and such). I suspect that there is no built-in type to use, and that I have to come up with my own way of storing text the way I want (which actually is fun). Am I right?

    Read the article

  • How to call function CreateProcess in Delphi Prism?

    - by Ilya
    I wrote function CreateProcess( lpApplicationName:String; lpCommandLine:String; lpProcessAttributes:IntPtr; lpThreadAttributes:IntPtr; bInheritHandles:Boolean; dwCreationFlags:Int32; lpEnvironment:IntPtr; lpCurrentDirectory:IntPtr; lpStartupInfo:STARTUPINFO; lpProcessInformation:ProcessInfo):Boolean; external 'kernel32.dll'; but VStudio said "Semicolon" expected - after external and " "end" expected" after 'kernel32.dll'; Can you help me to load and call a function please?

    Read the article

  • Delphi / ADO : how to get result of Execute() ?

    - by mawg
    I have declared AdoConnection : TADOConnection; and successfully connected to the default "mysql" database (so, no need to pass that code). Now, taking baby steps to learn, I would like to AdoConnection.Execute('SHOW DATABASES', cmdText); which seems to work ok, in the sense that it doesn't throw an exception, but I am such a n00b that I don't know how I can examine the result of the command :-/ Halp!

    Read the article

  • Problem with format a single excel column with OLE automation using Delphi

    - by Snackmoore
    Dear All, I have piece of code which I use to format a range of cells in Excel. It works fine in Excel 2007 but when the range is only 1 column wide and it is Excel 2003 instead of 2007, I'll get an error saying the I am assigning invalid value for a border's line style. ** valuables such as "xlInsideHorizontal", I have declared them as CONSTANT with the proper values. Please help. procedure formatCells(FRCELLROW, FRCELLCOL, TOCELLROW, TOCELLCOL: Integer; TOPSTYLE, TOPCOLOUR, TOPWEIGHT, BOTTOMSTYLE, BOTTOMCOLOUR, BOTTOMWEIGHT, LEFTSTYLE, LEFTCOLOUR, LEFTWEIGHT, RIGHTSTYLE, RIGHTCOLOUR, RIGHTWEIGHT: Integer; INNERVSTYLE, INNERVCOLOUR, INNERVWEIGHT: Integer; INNERHSTYLE, INNERHCOLOUR, INNERHWEIGHT: Integer; HORIZONTALCELLALIGNMENT: Integer; FontBold: Boolean; NumberFormat: String ); var tmpRange: Variant; begin tmpRange := eclApp.range[eclApp.Cells[FRCELLROW, FRCELLCOL], eclApp.Cells[TOCELLROW, TOCELLCOL]]; tmpRange.Borders[xlEdgeTop].LineStyle := TOPSTYLE; if TOPSTYLE <> xlNone then begin tmpRange.Borders[xlEdgeTop].ColorIndex := TOPCOLOUR; tmpRange.Borders[xlEdgeTop].Weight := TOPWEIGHT; end; //if tmpRange.Borders[xlEdgeBottom].LineStyle := BOTTOMSTYLE; if BOTTOMSTYLE <> xlNone then begin tmpRange.Borders[xlEdgeBottom].ColorIndex := BOTTOMCOLOUR; tmpRange.Borders[xlEdgeBottom].Weight := BOTTOMWEIGHT; end; //if tmpRange.Borders[xlEdgeLeft].LineStyle := LEFTSTYLE; if LEFTSTYLE <> xlNone then begin tmpRange.Borders[xlEdgeLeft].ColorIndex := LEFTCOLOUR; tmpRange.Borders[xlEdgeLeft].Weight := LEFTWEIGHT; end; //if tmpRange.Borders[xlEdgeRight].LineStyle := RIGHTSTYLE; if RIGHTSTYLE <> xlNone then begin tmpRange.Borders[xlEdgeRight].ColorIndex := RIGHTCOLOUR; tmpRange.Borders[xlEdgeRight].Weight := RIGHTWEIGHT; end; //if tmpRange.Borders[xlInsideVertical].LineStyle := INNERVSTYLE; if INNERVSTYLE <> xlNone then begin tmpRange.Borders[xlInsideVertical].ColorIndex := INNERVCOLOUR; tmpRange.Borders[xlInsideVertical].Weight := INNERVWEIGHT; end; //if tmpRange.Borders[xlInsideHorizontal].LineStyle := INNERHSTYLE; if INNERHSTYLE <> xlNone then begin tmpRange.Borders[xlInsideHorizontal].ColorIndex := INNERHCOLOUR; tmpRange.Borders[xlInsideHorizontal].Weight := INNERHWEIGHT; end; //if tmpRange.HorizontalAlignment := HORIZONTALCELLALIGNMENT; tmpRange.Font.Bold := FontBold; tmpRange.NumberFormat := NumberFormat; end; //

    Read the article

  • Delphi hook to redirect to different ip

    - by Chris
    What is the best way to redirect ANY browser to a different ip for specific sites? For example if the user will type www.facebook.com in any browser he will be redirected to 127.0.0.1. Also the same should happen if he will type 66.220.146.11. What I have until now is this: using the winpkfilter I am able to intercept all the traffic on port 80, with type(in or out), source ip, destination ip and packet. My problem is to modify somehow the packet so the browser will be redirected. This is the code that i have right now: program Pass; {$APPTYPE CONSOLE} uses SysUtils, Windows, Winsock, winpkf, iphlp; var iIndex, counter : DWORD; hFilt : THANDLE; Adapts : TCP_AdapterList; AdapterMode : ADAPTER_MODE; Buffer, ParsedBuffer : INTERMEDIATE_BUFFER; ReadRequest : ETH_REQUEST; hEvent : THANDLE; hAdapter : THANDLE; pEtherHeader : TEtherHeaderPtr; pIPHeader : TIPHeaderPtr; pTcpHeader : TTCPHeaderPtr; pUdpHeader : TUDPHeaderPtr; SourceIP, DestIP : TInAddr; thePacket : PChar; f : TextFile; SourceIpString, DestinationIpString : string; SourceName, DestinationName : string; function IPAddrToName(IPAddr : string) : string; var SockAddrIn : TSockAddrIn; HostEnt : PHostEnt; WSAData : TWSAData; begin WSAStartup($101, WSAData); SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr)); HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); if HostEnt < nil then begin result := StrPas(Hostent^.h_name) end else begin result := ''; end; end; procedure ReleaseInterface(); begin // Restore default mode AdapterMode.dwFlags := 0; AdapterMode.hAdapterHandle := hAdapter; SetAdapterMode(hFilt, @AdapterMode); // Set NULL event to release previously set event object SetPacketEvent(hFilt, hAdapter, 0); // Close Event if hEvent < 0 then CloseHandle(hEvent); // Close driver object CloseFilterDriver(hFilt); // Release NDISAPI FreeNDISAPI(); end; begin // Check the number of parameters if ParamCount() < 2 then begin Writeln('Command line syntax:'); Writeln(' PassThru.exe index num'); Writeln(' index - network interface index.'); Writeln(' num - number or packets to filter'); Writeln('You can use ListAdapters to determine correct index.'); Exit; end; // Initialize NDISAPI InitNDISAPI(); // Create driver object hFilt := OpenFilterDriver('NDISRD'); if IsDriverLoaded(hFilt) then begin // Get parameters from command line iIndex := StrToInt(ParamStr(1)); counter := StrToInt(ParamStr(2)); // Set exit procedure ExitProcessProc := ReleaseInterface; // Get TCP/IP bound interfaces GetTcpipBoundAdaptersInfo(hFilt, @Adapts); // Check paramer values if iIndex > Adapts.m_nAdapterCount then begin Writeln('There is no network interface with such index on this system.'); Exit; end; hAdapter := Adapts.m_nAdapterHandle[iIndex]; AdapterMode.dwFlags := MSTCP_FLAG_SENT_TUNNEL or MSTCP_FLAG_RECV_TUNNEL; AdapterMode.hAdapterHandle := hAdapter; // Create notification event hEvent := CreateEvent(nil, TRUE, FALSE, nil); if hEvent <> 0 then if SetPacketEvent(hFilt, hAdapter, hEvent) <> 0 then begin // Initialize request ReadRequest.EthPacket.Buffer := @Buffer; ReadRequest.hAdapterHandle := hAdapter; SetAdapterMode(hFilt, @AdapterMode); counter := 0; //while counter <> 0 do while true do begin WaitForSingleObject(hEvent, INFINITE); while ReadPacket(hFilt, @ReadRequest) <> 0 do begin //dec(counter); pEtherHeader := TEtherHeaderPtr(@Buffer.m_IBuffer); if ntohs(pEtherHeader.h_proto) = ETH_P_IP then begin pIPHeader := TIPHeaderPtr(Integer(pEtherHeader) + SizeOf(TEtherHeader)); SourceIP.S_addr := pIPHeader.SourceIp; DestIP.S_addr := pIPHeader.DestIp; if pIPHeader.Protocol = IPPROTO_TCP then begin pTcpHeader := TTCPHeaderPtr(Integer(pIPHeader) + (pIPHeader.VerLen and $F) * 4); if (pTcpHeader.SourcePort = htons(80)) or (pTcpHeader.DestPort = htons(80)) then begin inc(counter); if Buffer.m_dwDeviceFlags = PACKET_FLAG_ON_SEND then Writeln(counter, ') - MSTCP --> Interface') else Writeln(counter, ') - Interface --> MSTCP'); Writeln(' Packet size = ', Buffer.m_Length); Writeln(Format(' IP %.3u.%.3u.%.3u.%.3u --> %.3u.%.3u.%.3u.%.3u PROTOCOL: %u', [byte(SourceIP.S_un_b.s_b1), byte(SourceIP.S_un_b.s_b2), byte(SourceIP.S_un_b.s_b3), byte(SourceIP.S_un_b.s_b4), byte(DestIP.S_un_b.s_b1), byte(DestIP.S_un_b.s_b2), byte(DestIP.S_un_b.s_b3), byte(DestIP.S_un_b.s_b4), byte(pIPHeader.Protocol)] )); Writeln(Format(' TCP SRC PORT: %d DST PORT: %d', [ntohs(pTcpHeader.SourcePort), ntohs(pTcpHeader.DestPort)])); //get the data thePacket := pchar(pEtherHeader) + (sizeof(TEtherHeaderPtr) + pIpHeader.VerLen * 4 + pTcpHeader.Offset * 4); { SourceIpString := IntToStr(byte(SourceIP.S_un_b.s_b1)) + '.' + IntToStr(byte(SourceIP.S_un_b.s_b2)) + '.' + IntToStr(byte(SourceIP.S_un_b.s_b3)) + '.' + IntToStr(byte(SourceIP.S_un_b.s_b4)); DestinationIpString := IntToStr(byte(DestIP.S_un_b.s_b1)) + '.' + IntToStr(byte(DestIP.S_un_b.s_b2)) + '.' + IntToStr(byte(DestIP.S_un_b.s_b3)) + '.' + IntToStr(byte(DestIP.S_un_b.s_b4)); } end; end; end; // if ntohs(pEtherHeader.h_proto) = ETH_P_RARP then // Writeln(' Reverse Addr Res packet'); // if ntohs(pEtherHeader.h_proto) = ETH_P_ARP then // Writeln(' Address Resolution packet'); //Writeln('__'); if Buffer.m_dwDeviceFlags = PACKET_FLAG_ON_SEND then // Place packet on the network interface SendPacketToAdapter(hFilt, @ReadRequest) else // Indicate packet to MSTCP SendPacketToMstcp(hFilt, @ReadRequest); { if counter = 0 then begin Writeln('Filtering complete'); readln; break; end; } end; ResetEvent(hEvent); end; end; end; end.

    Read the article

  • Making a Label Visible/Not Visible in Delphi

    - by Hendriksen123
    I would like a button to change a label between being visible and not visible when clicked. I Tried the following code, but it doesnt work: Var: Hidden : Boolean; Begin If Hidden = True Then Begin Label6.Visible := True; Hidden := False; End; If Hidden = False Then Begin Label6.Visible := False; Hidden := True; End; It compiles, but doesn't work!

    Read the article

  • Delphi - Why is my global variable "inacessible" when i debug

    - by Antoine Lpy
    I'm building an application that contains around 30 Forms. I need to manage sessions, so I would like to have a global LoggedInUser variable accessible from all forms. I read "David Heffernan"'s post about global variables, and how to avoid them but I thought it would be easier to have a global User variable rather than 30 forms having their own User variable. So i have a unit : GlobalVars unit GlobalVars; interface uses User; // I defined my TUser class in a unit called User var LoggedInUser: TUser; implementation initialization LoggedInUser:= TUser.Create; finalization LoggedInUser.Free; end. Then in my LoginForm's LoginBtnClick procedure I do : unit FormLogin; interface uses [...],User; type TForm1 = class(TForm) [...] procedure LoginBtnClick(Sender: TObject); private { Déclarations privées } public end; var Form1: TForm1; AureliusConnection : IDBConnection; implementation {$R *.fmx} uses [...]GlobalVars; procedure TForm1.LoginBtnClick(Sender: TObject); var Manager : TObjectManager; MyCriteria: TCriteria<TUser>; u : TUser; begin Manager := TObjectManageR.Create(AureliusConnection); MyCriteria :=Manager.Find<TUtilisateur> .Add(TExpression.Eq('login',LoginEdit.Text)) .Add(TExpression.Eq('password',PasswordEdit.Text)); u := MyCriteria.UniqueResult; if u = nil then MessageDlg('Login ou mot de passe incorrect',TMsgDlgType.mtError,[TMsgDlgBtn.mbOK],0) else begin LoggedInUser:=u; //Here I assign my local User data to my global User variable Form1.Destroy; A00Form.visible:=true; end; Manager.Free; end; Then in another form I would like to access this LoggedInUser object in the Menu1BtnClick procedure : Unit C01_Deviations; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, FMX.ListView.Types, FMX.ListView, FMX.Objects, FMX.Layouts, FMX.Edit, FMX.Ani; type TC01Form = class(TForm) [...] Menu1Btn: TButton; [...] procedure Menu1BtnClick(Sender: TObject); private { Déclarations privées } public { Déclarations publiques } end; var C01Form: TC01Form; implementation uses [...]User,GlobalVars; {$R *.fmx} procedure TC01Form.Menu1BtnClick(Sender: TObject); var Assoc : TUtilisateur_FonctionManagement; ValidationOK : Boolean; util : TUser; begin ValidationOK := False; util := GlobalVars.LoggedInUser; // Here i created a local user variable for debug purposes as I thought it would permit me to see the user data. But i get "Inaccessible Value" as its value util.Nom:='test'; for Assoc in util.FonctionManagement do // Here is were my initial " access violation" error occurs begin if Assoc.FonctionManagement.Libelle = 'Reponsable équipe HACCP' then begin ValidationOK := True; break; end; end; [...] end; When I debug I see "Inaccessible Value" in the value column of my user. Do you have any idea why ? I tried to put an integer in this GlobalVar unit, and i was able to set its value from my login form and read it from my other form.. I guess I could store the user's id, which is an integer, and then retrieve the user from the database using its id. But it seems really unefficient.

    Read the article

  • Delphi interface cast using TValue

    - by conciliator
    I've recently experimented extensively with interfaces and D2010 RTTI. I don't know at runtime the actual type of the interface; although I will have access to it's qualified name using a string. Consider the following: program rtti_sb_1; {$APPTYPE CONSOLE} uses SysUtils, Rtti, TypInfo, mynamespace in 'mynamespace.pas'; var ctx: TRttiContext; InterfaceType: TRttiType; Method: TRttiMethod; ActualParentInstance: IParent; ChildInterfaceValue: TValue; ParentInterfaceValue: TValue; begin ctx := TRttiContext.Create; // Instantiation ActualParentInstance := TChild.Create as IParent; {$define WORKAROUND} {$ifdef WORKAROUND} InterfaceType := ctx.GetType(TypeInfo(IParent)); InterfaceType := ctx.GetType(TypeInfo(IChild)); {$endif} // Fetch interface type InterfaceType := ctx.FindType('mynamespace.IParent'); // This cast is OK and ChildMethod is executed (ActualParentInstance as IChild).ChildMethod(100); // Create a TValue holding the interface TValue.Make(@ActualParentInstance, InterfaceType.Handle, ParentInterfaceValue); InterfaceType := ctx.FindType('mynamespace.IChild'); // This cast doesn't work if ParentInterfaceValue.TryCast(InterfaceType.Handle, ChildInterfaceValue) then begin Method := InterfaceType.GetMethod('ChildMethod'); if (Method <> nil) then begin Method.Invoke(ChildInterfaceValue, [100]); end; end; ReadLn; end. The contents of mynamespace.pas is as follows: {$M+} IParent = interface ['{2375F59E-D432-4D7D-8D62-768F4225FFD1}'] procedure ParentMethod(const Id: integer); end; {$M-} IChild = interface(IParent) ['{6F89487E-5BB7-42FC-A760-38DA2329E0C5}'] procedure ChildMethod(const Id: integer); end; TParent = class(TInterfacedObject, IParent) public procedure ParentMethod(const Id: integer); end; TChild = class(TParent, IChild) public procedure ChildMethod(const Id: integer); end; For completeness, the implementation goes as procedure TParent.ParentMethod(const Id: integer); begin WriteLn('ParentMethod executed. Id is ' + IntToStr(Id)); end; procedure TChild.ChildMethod(const Id: integer); begin WriteLn('ChildMethod executed. Id is ' + IntToStr(Id)); end; The reason for {$define WORKAROUND} may be found in this post. Question: is there any way for me to make the desired type cast using RTTI? In other words: is there a way for me to invoke IChild.ChildMethod from knowing 1) the qualified name of IChild as a string, and 2) a reference to the TChild instance as a IParent interface? (After all, the hard-coded cast works fine. Is this even possible?) Thanks!

    Read the article

  • Delphi: Autoscale TEdit based on text length does not work when removing chars

    - by pr0wl
    Hello. I have an input edit field where the user can enter data. I want the box width to be at least 191px (min) and maximum 450px (max). procedure THauptform.edtEingabeChange(Sender: TObject); begin // Scale if Length(edtEingabe.Text) > 8 then begin if Hauptform.Width <= 450 then begin verschiebung := verschiebung + 9; // The initial values like 'oldedtEingabeWidth' are global vars. edtEingabe.Width := oldedtEingabeWidth + verschiebung; buDo.Left := oldbuDoLeft + verschiebung; Hauptform.Width := oldHauptformWidth + verschiebung; end; end; end; This works for ENTERING text. But when I delete one char, it does not scale back accordingly.

    Read the article

  • how to save extracted icon in delphi

    - by radick
    hi all I am trying to make icon extractor i am successful in getting icon to image1.picture.icon ,its looking same as orginal file icon, but when i am trying to save (iamge1.picture.icon.savetofile(c:\imahe.ico)) its not saving as it is ,it saving with less colur and looking ugly cany any one please tell me what i am doing wrong ? here is my code procedure TForm1.Button1Click(Sender: TObject); begin OpenDialog1.Filter:='All files |*.*'; OpenDialog1.Title:='Please select file'; if OpenDialog1.Execute then Edit1.Text:=OpenDialog1.FileName; end; procedure TForm1.Button3Click(Sender: TObject); var szFileName: string; Icon: TIcon; SHInfo: TSHFileInfo; begin szFileName := Edit1.Text; if FileExists(Edit1.Text) then begin Icon := TIcon.Create; SHGetFileInfo(PChar(szFileName), 0, SHInfo, SizeOf(SHInfo), SHGFI_ICON); Icon.Handle := SHInfo.hIcon; Image1.Picture.Icon := Icon; end; end; procedure TForm1.Button2Click(Sender: TObject); begin if SaveDialog1.Execute then begin Image1.Picture.Icon.SaveToFile(SaveDialog1.FileName+'.ico'); ShowMessage('done'); end; end;

    Read the article

  • Delphi - Populate an imagelist with icons at runtime 'destroys' transparency

    - by ben
    Hi again, I've spended hours for this (simple) one and don't find a solution :/ I'm using D7 and the TImageList. The ImageList is assigned to a toolbar. When I populate the ImageList at designtime, the icons (with partial transparency) are looking fine. But I need to populate it at runtime, and when I do this the icons are looking pretty shitty - complete loose of the partial transparency. I just tried to load the icons from a .res file - with the same result. I've tried third party image lists also without success. I have no clue what I could do :/ Thanks 2 all ;) edit: To be honest I dont know exactly whats going on. Alpha blending is the correkt term... Here are 2 screenies: Icon added at designtime: Icon added at runtime: Your comment that alpha blending is not supported just brought the solution: I've edited the image in an editor and removed the "alpha blended" pixels - and now it looks fine. But its still strange that the icons look other when added at runtime instead of designtime. If you (or somebody else ;) can explain it, I would be happy ;) thanks for you support!

    Read the article

facebook twitter digg google delicious technorati stumbleupon myspace wordpress linkedin gmail igoogle windows live tumblr viadeo yahoo buzz yahoo mail yahoo bookmarks favorites email print

< Previous Page | 18 19 20 21 22 23 24 25 26 27 28 29  | Next Page >