Search Results

Search found 1605 results on 65 pages for 'delphi xe2'.

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/65 | < Previous Page | 18 19 20 21 22 23 24 25 26 27 28 29  | Next Page >

  • 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

  • Delphi Application using COMMIT and ROLLBACK for Multiple SQL Updates

    - by Matt
    Is it possible to use the SQL BEGIN TRANSACTION, COMMIT TRANSACTION, ROLLBACK TRANSACTION when embedding SQL Queries into an application with mutiple calls to the SQL for Table Updates. For example I have the following code: Q.SQL.ADD(<UPDATE A RECORD>); Q.ExecSQL; Q.Close; Q.SQL.Clear; Q.SQL.ADD(<Select Some Data>); Q.Open; Set Some Variables Q.Close; Q.SQL.Clear; Q.SQL.ADD(<UPDATE A RECORD>); Q.ExecSQL; What I would like to do is if the second update fails I want to roll back the first transaction. If I set a unique notation for the BEGIN, COMMIT, ROLLBACK so as to specify what is being committed or rolled back, is it feasible. i.e. before the first Update specify BEGIN TRANSACTION_A then after the last update specify COMMIT TRANSACTION_A I hope that makes sense. If I was doing this in a SQL Stored Procedure then I would be able to specify this at the start and end of the procedure, but I have had to break the code down into manageable chunks due to process blocks and deadlocks on a heavy loaded SQL Server.

    Read the article

  • Embedding a font in delphi

    - by ChuckO
    I'm working on an app that requires a particular barcode true type font that is unlikely to be on the user's PC. Can I somehow embed the font in the app, or do I need to use the installer to install the font?

    Read the article

  • Delphi, PGDac vs Zeos, Fetch, Lookup?

    - by durumdara
    Hi! I used Zeos to test to know: is ZTable uses fetch technics, or not? May in the future we migrate our lesser system to PGSQL, and this used now "Table" components (as BDE, but it have an SQL-like server). These tables use real cursors, a "Window" with N record, so lookup is very fast, because the Locate/Lookup is started on server, and only these N records are refreshed, no matter, how many records in the lookup table. PGSQL uses fetch technics as I know, and I tested it with a table (id int, name varchar(100)), and 1 million records. (I also trying this with mysql). The adapter is Zeos. ID, sec to find, allocated memory in bytes on client. MySQL 500000 2,761 113 196 344 1000000 3,214 225 471 232 313800 0,437 225 471 232 328066 0,468 225 471 232 276374 0,390 225 471 232 905984 1,264 225 471 232 260253 0,359 225 471 232 PGSQL 500000 3,042 113 188 184 1000000 3,744 225 463 064 313800 0,436 225 463 064 328066 0,452 225 463 064 276374 0,375 225 463 064 905984 1,295 225 463 064 260253 0,359 225 463 064 142023 0,203 225 463 064 As you see the records are fetched locally, this cause the 225 MB usage, and searches are slow a little, based where is the record we must find. I want to ask more things: a.) Is PGDAC have some technics to we can use the lookups without pay the fetch with memory and secs? b.) Or is PG ODBC driver can help in this problem with ADO? (As I know ADO can use server side cursors)? c.) Have anybody some experience with lookup tables, and performance? Is this critical question or it is not? (With client memory usage too). d.) If no chance to avoid fetch hell with lookups, what we can do? Server Side Joins, and unique code for Lookup field changing without real Lookup? Thanks for your help: dd

    Read the article

  • Delphi Shell IExtractIcon usage and result

    - by Roy M Klever
    What I do: Try to extract thumbnail using IExtractImage if that fail I try to extract icons using IExtractIcon, to get maximum iconsize, but IExtractIcon gives strange results. Problem is I tried to use a methode that extracts icons from an imagelist but if there is no large icon (256x256) it will render the smaller icon at the topleft position of the icon and that does not look good. That is why I am trying to use the IExtractIcon instead. But icons that show up as 256x256 icons in my imagelist extraction methode reports icon sizes as 33 large and 16 small. So how do I check if a large (256x256) icon exists? If you need more info I can provide som sample code. if PThumb.Image = nil then begin OleCheck(ShellFolder.ParseDisplayName(0, nil, StringToOleStr(PThumb.Name), Eaten, PIDL, Atribute)); ShellFolder.GetUIObjectOf(0, 1, PIDL, IExtractIcon, nil, XtractIcon); CoTaskMemFree(PIDL); bool:= False; if Assigned(XtractIcon) then begin GetLocationRes := XtractIcon.GetIconLocation(GIL_FORSHELL, @Buf, sizeof(Buf), IIdx, IFlags); if (GetLocationRes = NOERROR) or (GetLocationRes = E_PENDING) then begin Bmp := TBitmap.Create; try OleCheck(XtractIcon.Extract(@Buf, IIdx, LIcon, SIcon, 32 + (16 shl 16))); Done:= False; Roy M Klever

    Read the article

  • using LocalAsyncVclCall in Delphi

    - by Salvador
    Actually i am using the AsyncCalls library to execute an Query asynchronously in this way. while AsyncMultiSync([RunQuery], True, 10) = WAIT_TIMEOUT do begin FrmProgress.refresh; //Update the ellapsed time in a popup form Application.ProcessMessages; end; and everything works ok. Now i want to do the same for load the query in a grid. so i tried this while LocalAsyncVclCall(@InitGrid, 10) = WAIT_TIMEOUT do begin FrmProgress.refresh; Application.ProcessMessages; end; but obviously not compile because the type returned by LocalAsyncVclCall is IAsyncCall and not a Cardinal. also i tried this, but not works. while not LocalAsyncVclCall(@InitGrid, 10).Finished do begin FrmProgress.refresh; Application.ProcessMessages; end; How i can use LocalAsyncVclCall or another function to execute an VCL code asynchronously . i want something like this. while ExecuteMyVCLProcedure(@InitGrid) = WAIT_TIMEOUT do begin FrmProgress.refresh; Application.ProcessMessages; end; Thanks in advance.

    Read the article

  • Delphi 7 inheritance

    - by Gene
    Have 6 forms, 1 Base and 5 inherited.The Base has the following snippet: procedure TMechan.Open1Click(Sender: TObject); begin if OpenDialog1.Execute then Form1.Memo1.Lines.LoadFromFile(OpenDialog1.FileName ); CopyCylMemoToRecord;ShowMechanicalValues; end; Since this snippet is in the Base it's also inherited by 5 others. Problem is: When executing OpenDialog the Base is overwritten instead of the inherited form. HELP

    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 >