Solved

Delphi Programming question

Posted on 1997-09-04
18
223 Views
Last Modified: 2010-04-03
Hello folks,

Well, I'm looking for the source code of the fields editor which you can call from a TTable or TQuery. Or if someone knows of a sort alike freeware component with SOURCE, please give me a sign.
I'd like to study that source-code, because I need it for a new idea of component which is boiling in my head.

Thanks in advance!
Have fun,
c.u. ZifNab;
0
Comment
Question by:ZifNab
  • 10
  • 8
18 Comments
 
LVL 3

Expert Comment

by:mirek071497
ID: 1343603
From Borland Technical Information Database :

The code snippet below demonstrates creating a TStringField. The
containing TForm is called Form1 (referred to here with the Self
variable), the active data set is a TQuery named Query1, and the field for
which the TStringField component is being created is a dBASE table field
named CO_NAME. This new TField descendant will be the second TField in the
Fields array property of Query1. Note that the data set with which the new

TField descendant will be associated (in this case, Query1) must be closed
prior to adding the TField and then reopened afterwards.
 
procedure TForm1.Button2Click(Sender: TObject);
var
  T: TStringField;
begin
  Query1.Close;
  T := TStringField.Create(Self);

  T.FieldName := 'CO_NAME';
  T.Name := Query1.Name + T.FieldName;
  T.Index := Query1.FieldCount;
  T.DataSet := Query1;
  Query1.FieldDefs.UpDate;
  Query1.Open;
end;
 
The example above example creates a new TStringField named Query1CO_NAME.

 
Deleting an existing TField descendant is merely a matter of invoking the
Free method for that component. In the example below, the TForm's Find-
Component method is used to return a pointer to the TStringField component
named Query1CO_NAME. The return value for the FindComponent will either be
of type TComponent if successful or nil if unsuccessful. This return value
can be used to determine whether the component actually exists prior to
invoking its Free method.

 
procedure TForm1.Button1Click(Sender: TObject);
var
  TC: TComponent;
begin
  TC := FindComponent('Query1CO_NAME');
  if not (TC = nil) then begin
    Query1.Close;
    TC.Free;
    Query1.Open;
  end;
end;
 
As with creating a TField, if the data set associated with the TField
descendant is currently active, it must be closed or deactivated prior to
invoking this method.
 

0
 
LVL 8

Author Comment

by:ZifNab
ID: 1343604
Hi mirek,

It's not exactly what I'm looking for. I wanted to make a sort of field editor which you can use in design-time. I believe that if you use the fields-editor in design-time and you add a new or a data-field than the editor autometicaly adds source code to your code. The example you gave me doesn't do this. But thanks anyway
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1343605
If you have more points i can give you link to source of project.
0
 
LVL 8

Author Comment

by:ZifNab
ID: 1343606
How much points do you want?
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1343607
Some more, because i think so this is not very easy.
0
 
LVL 8

Author Comment

by:ZifNab
ID: 1343608
True, it isn't easy, but giving a link isn't difficult also.
Ofcourse, if searching for that link costed you a lot of time, it's worth giving more points. But I'll increase the points. I you want more, just ask.

0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1343609
If you have not more then no problem. My english is .. I give you not link to file but way how to do this. Wait a moment i find the code on my HD, cut some for you, test and submit here.
0
 
LVL 8

Author Comment

by:ZifNab
ID: 1343610
Ok, if you have found some time and the code works, please send it to me. I'll increase the points if it's what i'm looking for.

ZifNab.
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1343611
Sorry i receive yesterday very important work so i must complete this, but I return tomorrow and give you the code.
0
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 
LVL 8

Author Comment

by:ZifNab
ID: 1343612
Ok, I can wait. It isn't something I need for my work.
Take your time. Your work has to come first offcourse.

c.u


0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1343613
Hi
I found some bugs with code which i have from SWAG. It doesn't work but i try to correct this. Do you try look at EditIntf.pas and ExptIntf ? This is what you need but some complicated. In SWAG new collection is example of using this but with bugs.
0
 
LVL 3

Accepted Solution

by:
mirek071497 earned 20 total points
ID: 1343614
i made some errors later. This now works.

This is example of expert which you can find (after installing as a component) at menu tools. When you click on this then you can  search and replace in project source.

unit mwIDEExp;
{+--------------------------------------------------------------------------+
 | Unit:        mwIDEExpert
 | Author:      Martin Waldenburg
 | Status:      FreeWare
 +--------------------------------------------------------------------------+}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExptIntf, ToolIntf, mwIDEStr, StdCtrls;

type
  TaForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

  TMyIDEExpertExpert = class(TIExpert)
  private
    MenuItem: TIMenuItemIntf;
  protected
    procedure OnClick( Sender: TIMenuItemIntf); virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function GetName: string; override;
    function GetAuthor: string; override;
    function GetStyle: TExpertStyle; override;
    function GetIDString: string; override;
  end;

procedure Register;

var aForm1 : TaForm1;

implementation

{$R *.DFM}

procedure Register;
begin
  RegisterLibraryExpert(TMyIDEExpertExpert.Create);
end;

{ TMyIDEExpertExpert code }
function TMyIDEExpertExpert.GetName: String;
begin
  Result := 'MyIDEExpertExpert'
end;

function TMyIDEExpertExpert.GetAuthor: String;
begin
  Result := 'Martin_Waldenburg'; { author }
end;

function TMyIDEExpertExpert.GetStyle: TExpertStyle;
begin
  Result := esAddIn;
end;

function TMyIDEExpertExpert.GetIDString: String;
begin
  Result := 'private.MyIDEExpertExpert';
end;

constructor TMyIDEExpertExpert.Create;
var
  Main: TIMainMenuIntf;
  ReferenceMenuItem: TIMenuItemIntf;
  Menu: TIMenuItemIntf;
begin
  inherited Create;
  MenuItem := nil;
  if ToolServices <> nil then begin { I'm an expert! }
    Main := ToolServices.GetMainMenu;
    if Main <> nil then begin { we've got the main menu! }
      try
        { add the menu of your choice }
        ReferenceMenuItem := Main.FindMenuItem('ToolsOptionsItem');
        if ReferenceMenuItem <> nil then
        try
          Menu := ReferenceMenuItem.GetParent;
          if Menu <> nil then
          try
            MenuItem := Menu.InsertItem(ReferenceMenuItem.GetIndex+1,
                              'MyIDEExpert',
                              'MyIDEExpertExpertItem','',
                              0,0,0,
                              [mfEnabled, mfVisible], OnClick);
          finally
            Menu.DestroyMenuItem;
          end;
        finally
          ReferenceMenuItem.DestroyMenuItem;
        end;
      finally
        Main.Free;
      end;
    end;
  end;
end;

destructor TMyIDEExpertExpert.Destroy;
begin
  if MenuItem <> nil then
    MenuItem.DestroyMenuItem;
  inherited Destroy;
end;{Destroy}

procedure TMyIDEExpertExpert.OnClick( Sender: TIMenuItemIntf);
begin
  with TaForm1.Create( Application ) do
    try
      { do your processing here }
      ShowModal;
    finally
      Free;
    end;
end;

{ TForm1 code }

procedure TaForm1.Button1Click(Sender: TObject);
var
  IDEStream: TIDEStream;
  StreamText, UText, UFind, fReplace: String;
  FindLen, P: LongInt;
begin
  IDEStream:= TIDEStream.Create;
  StreamText:= IDEStream.GetText;
  UText:= UpperCase(StreamText);
  UFind:= UpperCase(Trim(Edit1.Text));
  fReplace:= Trim(Edit2.Text);
  FindLen:= Length(UFind);
  P:= Pos(UFind, UText);
  if P <> 0 then
  begin
    Delete(StreamText, P, FindLen);
    Insert(fReplace, StreamText, P);
    IDEStream.WriteText(PChar(StreamText));
  end;
  IDEStream.Free;
end;

end.






{+--------------------------------------------------------------------------+
 | Class:       TIDEStream
 | Author:      Martin Waldenburg
 | Status:      FreeWare
 +--------------------------------------------------------------------------+}
unit mwIDEStr;

interface

uses
  Windows,
  SysUtils,
  Messages,
  Classes,
  ToolIntf,
  EditIntf,
  ExptIntf;

type
  TIDEStream = class(TMemoryStream)
  private
    fStreamTextLen:Longint;
    function GetAsPChar:PChar;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure WriteText(Text: PChar);
    property Capacity;
    property AsPChar:PChar read GetAsPChar;
    function GetText:PChar;
    property StreamTextLen:Longint read fStreamTextLen;
  published
  end;

var
  fToolServices : TIToolServices;
  fModuleInterface: TIModuleInterface;
  fEditorInterface: TIEditorInterface;
  ActualReader: TIEditReader;
  ActualWriter: TIEditWriter;

implementation

function GetProjectName: String;
begin
  Result:= fToolServices.GetProjectName;
end;  { GetProjectName }

function GetCurrentFile: String;
begin
  Result:= fToolServices.GetCurrentFile;
end;   { GetCurrentFile }

function GetToolServieces:TIToolServices;
var
  FileExt: String;
begin
  fToolServices:= ExptIntf.ToolServices;
 if GetProjectName = '' then raise exception.create('Sorry, a project must be open');
   FileExt:= ExtractFileExt(GetCurrentFile);
  if FileExt = '.dfm' then raise exception.create('Sorry, must be a PAS or DPR file');
end;  { GetToolServieces }

procedure GetEditReader;
begin
  GetToolServieces;
  fModuleInterface:= fToolServices.GetModuleInterface(GetCurrentFile);
  fEditorInterface:= fModuleInterface.GetEditorInterface;
  ActualReader:= fEditorInterface.CreateReader;
end;  { GetEditReader }

procedure GetEditWriter;
begin
  GetToolServieces;
  fModuleInterface:= fToolServices.GetModuleInterface(GetCurrentFile);
  fEditorInterface:= fModuleInterface.GetEditorInterface;
  ActualWriter:= fEditorInterface.CreateWriter;
end;  { GetEditWriter }

procedure FreeEditReader;
begin
  ActualReader.Free;
  fEditorInterface.Free;
  fModuleInterface.Free;
end;  { GetEditorInterface }

procedure FreeEditWriter;
begin
  ActualWriter.Free;
  fEditorInterface.Free;
  fModuleInterface.Free;
end;  { GetEditorInterface }

destructor TIDEStream.Destroy;
begin
  inherited Destroy;
end;  { Destroy }

constructor TIDEStream.Create;
begin
  inherited Create;
  fStreamTextLen:= 0;
end;  { Create }

function TIDEStream.GetAsPChar:PChar;
const
  TheEnd: Char = #0;
begin
  Position:= Size;
  Write(TheEnd, 1);
  SetPointer(Memory, Size -1);
  Result:= Memory;
end;  { GetAsPChar }

function TIDEStream.GetText:PChar;
const
  BuffLen = 16383;
var
  TextBuffer: PChar;
  Readed, BuffPos: LongInt;
begin
  Clear;
  GetMem(TextBuffer, BuffLen +1);
  BuffPos:= 0;
  GetEditReader;
  try
    repeat
      Readed:= ActualReader.GetText(BuffPos, TextBuffer, Bufflen);
      Write(TextBuffer^, Readed);
      inc(BuffPos, Readed);
    until Readed < BuffLen;
  finally
  FreeEditReader;
  FreeMem(TextBuffer, BuffLen +1);
  end;
  fStreamTextLen:= Size;
  Result:= AsPchar;
end;

procedure TIDEStream.WriteText(Text: PChar);
begin
  GetEditWriter;
  try
    ActualWriter.CopyTo(0);
    ActualWriter.DeleteTo(fStreamTextLen -1);
    ActualWriter.Insert(Text);
  finally
    FreeEditWriter;
  end;
end;

end.




0
 
LVL 8

Author Comment

by:ZifNab
ID: 1343615
Hi mirek,

10x for answering, but I've never heard about ExptIntf, ToolIntf.

Are they from D3? Forgot to mention that I work on D2.
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1343616
This need run in Delph2 and Delphi3, but i test this only in Delphi3. Delphi2 have the same units ! Do you try compile this ?
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1343617
Try FindFile. This need be in Delphi 20\Source\ToolsApi\
0
 
LVL 8

Author Comment

by:ZifNab
ID: 1343618
Hi mirek,

I'm sorry, but have lot's of other things to do. So I haven't tried your example out. If I could ask a question, 'can somebody make some extra time for me with a delphi program', I would ask!
Let say, instead of a 24h day -> 48h day?
I'm already going to assess this question, because you made a lot of time for answering it. I'm sure it will work and you're an EXPERT.
Later when I find the time, I'll look at it. I'll send a comment to here. And if there are still some question, I'll make a new question. Yuo're welcome to solve that too. Hope you'll look at it.

10x already for the spended time. And see you soon.

Have fun,
ZifNab;
0
 
LVL 8

Author Comment

by:ZifNab
ID: 1343619
I'm sorry, about the points. I really wanted to give you more. I did, but there's something strange going on on this site. Question names are changing etc. Even the balance of my points isn't correct. I don't know, maybe it's only with me.
Next time, you'll get more. Promised
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1343620
No problem.
If you will have problems then ask.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
This video discusses moving either the default database or any database to a new volume.
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

24 Experts available now in Live!

Get 1:1 Help Now