1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

object Form1:TForm_DFMPreview
  BorderStyle = bsSizeToolWin
  Caption = 'Form1'
  Height = 300
  Left = 505
  Visible = True
  Width = 400
  object Animate1: TAnimate
    Width = 120
    Visible = True
    Top = 10
    Left = 10
    Height = 21
    object TreeView1: TTreeView
      Width = 120
      Visible = True
      Top = 10
      Left = 10
      Height = 21
    end
  end
end                    

1:

  [Fataler Fehler] Package 'IcsDel30' wird benötigt, konnte aber nicht gefunden werden                    

1:

[Fataler Fehler] Package 'dclstd30' wird benötigt, konnte aber nicht gefunden werden                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:

0.1.1.13:
  saving window-sizes and positions
  no need for restart dfmedit when changing language back to german
  Type-enumeration for TCollections
  Flag-Images for Languages (in Preferences-Dialog)
  allow editing of Stringlist,TPicture,TBitmap and TIcon-Properties in Preview
  preferences-dialog
  lazarus-unit-support
  adding lazarus-form to open-/save-filter (*.lfm)
  result of setproperty
  auto-filled ObjectInspector
  new key-bindings
  help-file updated
  some optimizations
  splitting functions_u.pas (separating RTTI-functions)
  doubleclick on property text shows Add/Edit-Dialog
  loading vcl-packages (for 3rd party components, see help)
  adding escape-key to inspector (restoring last value)
  Autofilled Procedure-names for events
  Statusbar-resizing
  component-hierarchy (in add/edit-dialog)
  find node by text
  supporting unknown properties in TCollection (deleted for preview)
  want-to-close-question if file is changed
  bugs fixed
    - in preview try to create new object, cancel
    - AV in preview when loading a form which has same name as a Form-Resource and changing a property
    - delete-key should only delete node when treeview active
    - file not saved if dfmedit opened with file as parameter
    - inspector-window not visible in maximized state
    - different bugs from previos beta-versions fixed
    - search/replace-pagecontrol visible when importing text to tree
    - changed isNumeric-function to prevent massive breaks when debugger turned on
    - class-properties which has no subproperties (like TImage.Picture) are not shown in Objectinspector
    - handles can be negative on Win9x/ME
    - enter to confirm Edit/Add-Dialog is not working when spinbutton is visible (spinbutton replaced by TUpDown)
    - subclasses not enumerated
    - empty lines in Tstrings cut off
    - relative path of lazres and packages
    - AV when trying to Save Image
    - bug with image/imagelist-tab
    - bug with CB_Value.Style for Enums
    - string decoding is rewritten and Tcollection-Items will now also en-/decoded
    - invalid pointer/AV on exit when deleting special-Type
    - AV when preview a form with TMainMenu+TMenuItems (many thanks to BenBE)
    - prevent tab-changing when node change unconfirmed                    

1:
2:
3:
4:
5:
6:
7:
8:

  pStep:=Treeview.Items.Count div 100;
  pNext:=pStep;
  while ...
    if (isObject(tn)) and (assigned(callback)) and (tn.AbsoluteIndex>pNext) then
    begin
      callback((100*tn.AbsoluteIndex) div treeview.items.count,'');
      inc(pNext,pStep);
    end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:

  X := Treeview.Items.Count;
  pStep:=X div 100; 
  pNext:=pStep; 
  while ... 
    if (isObject(tn)) and (assigned(callback)) and (tn.AbsoluteIndex>pNext) then 
    begin 
      callback((100*tn.AbsoluteIndex) div X ,''); 
      inc(pNext,pStep); 
    end;                    

1:

if assigned(Comp) then freeandnil(comp);                    

1:

        if copy(tn.Text,1,2)<>'On' then //fehler wegen fehlender event-methoden beheben                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

function isCharAtPos(s:pchar; c:char; p: integer):boolean; // ungefährliche funktion, da bei ein leerer oder zu kurzer string durch IsBadReadPtr abgefangen wird
begin
  result := false;
  if (p = 0) or (s=nil) then exit;
  inc(s,p-1);
  if not IsBadReadPtr(s,1) then begin
    if s^ = c then result := true;
  end;
end;

function isFirstChar(s:pchar; c:char):boolean;
begin
  result := isCharAtPos(s,c,1);
end;

...
        if not ((isFirstChar(pchar(tn.Text),'O')) and (isCharAtPos(pchar(tn.Text),'n',2))) then                    

1:
2:
3:
4:
5:
6:
7:

      if (copy(s,1,1)='i') then // bei jedem durchlauf ein string alloziert
      begin
        if copy(s,1,6)='inline' then  // und wenn der mit 'i' anfängt, gleich nochmal
          s:='object'+copy(s,7,length(s)-6);
        if copy(s,1,9)='inherited' then // und nochmal, fall die vorherige bedingung nicht zutraf
          s:='object'+copy(s,10,length(s)-9); 
      end;                    

1:
2:
3:
4:
5:
6:
7:

      if (isFirstChar(pchar(s),'i')) and IsCharAtPos(pchar(s),'n',2) then //überprüfe direkt an der speicheradresse ob der string mit 'in' beginnt: aufwand: ca 40 zeilen assembler
      begin
        if copy(s,1,6)='inline' then // und nur falls der mit 'in' anfängt, wird dann mit speicher rumhantiert...
          s:='object'+copy(s,7,length(s)-6);
        if copy(s,1,9)='inherited' then
          s:='object'+copy(s,10,length(s)-9);
      end;                    

1:
2:
3:
4:

procedure TForm_DFMInspector.FormDestroy(Sender: TObject);
begin
  freeObjects;
end;                    

1:
2:
3:
4:

procedure TForm_DFMInspector.SetOIOnlySize;
begin
  freeObjects;
...                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

//functions_u.pas:
procedure FreeSLObjects(list:TStrings);
var i:integer;
begin
  for i:=0 to list.Count-1 do
    if assigned(list.Objects[i]) then
    begin
      list.Objects[i].free;
      list.Objects[i]:=nil;
    end;
end;
//rttifunctions_u.pas
procedure GetComponentProps(AComponent:string;List:TStrings;AppendSubclasses:boolean);
var
...
begin
  //classe:=getclass(AComponent);
  FreeSLObjects(list);
  list.clear;

//addproperty_u.pas:
procedure TForm_DFMAdd.FormDestroy(Sender: TObject);
begin
  FreeSLObjects(cb_Name.Items);
  FreeSLObjects(cb_SubClass.Items);
end;                    

1:
2:
3:
4:
5:

  if isFirstChar(pchar(s),'i') then
  begin
    p:=pos(' ',s);
    s:='object'+copy(s,p,length(s)-p+1);
  end;                    

1:
2:
3:
4:
5:
6:
7:

function isLastChar(s:pchar; c:char):boolean;
// achtung: funktioniert nur wenn s auf einen "richtigen" delphi-string zeigt !
begin
  result := false;
  if (s=nil) then exit;
  result := isCharAtPos(s,c,pcardinal(cardinal(s) - 4)^);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:

var time : integer;
procedure StartPerfCounter;
begin
  time := Gettickcount;
end;

function StopPerfCounter:string;
begin
  result:=formatfloat('0.00',(Gettickcount - time) / 1000);
end;

function isCharAtPos(s:pchar; c:char; p: integer):boolean; // ungefährliche funktion, da bei ein leerer oder zu kurzer string durch IsBadReadPtr abgefangen wird
begin
  result := false;
  if (p = 0) or (s=nil) then exit;
  inc(s,p-1);
  if not IsBadReadPtr(s,1) then begin
    if s^ = c then result := true;
  end;
end;

function isLastChar(s:pchar; c:char):boolean;
// achtung: funktioniert nur wenn s auf einen "richtigen" delphi-string zeigt !
begin
  result := false;
  if (s=nil) then exit;
  result := isCharAtPos(s,c,pcardinal(cardinal(s) - 4)^);
end;

function isLastCharSlow(s:pchar; c:char):boolean;
// deine variante
begin
  result := isCharAtPos(s,c,length(s));
end;

procedure TForm1.Button1Click(Sender: TObject);
var s: string;
  i : integer;
begin
  s := 'bla';
  s := s + ' blubb';
  startperfcounter;
  for i := 1 to 10000000 do
   if islastcharSlow(pchar(s),'b') then asm nop end;
  caption := stopperfcounter;
end;


procedure TForm1.Button2Click(Sender: TObject);
var s: string;
  i : integer;
begin
  s := 'bla';
  s := s + ' blubb';
  startperfcounter;
  for i := 1 to 10000000 do
   if islastchar(pchar(s),'b') then asm nop end;
  caption := stopperfcounter;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:

function file2string(filename : string): string;
var f: Thandle;
    fs:dword;
    dwRead:DWORD;
begin
    result:='';
    f:=CreateFile(@filename[1],GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
    if f <> INVALID_HANDLE_VALUE then begin
       fs:=GetFileSize(f,nil);
       if fs <> 0 then begin
         setlength(result,fs);
         readfile(f,pointer(result)^,fs,dwRead,nil);
       end;
       closehandle(f);
    end;
end;

function LoadDFMFile(filename:string;var DestString: String):boolean;
var 
  fc  : string; // filecontent in a stringbuffer.  
  buf : string;
begin
    fc := file2string(filename);
    buf:=lowercase(copy(fc,1,6));
    result:=(buf <> 'object') and (buf <> 'inline') and (buf <> 'inheri');
    if result then
    begin
      ObjectResourceToText(fc, deststring)
    end else
      deststring := fc;

end;

//und hier mein programmgerüst (ich will eigentlich sowenig units wie möglich einbinden damit die exe-grösse schlank bleibt:
program dfmconvert;
// saves a binary DFM file as text.
// based on DFMEDIT by frank wunderlich
{$APPTYPE CONSOLE}

uses
  fastmm4,
  windows,
  stringtools,
//  functions_u,
 // dfm_parse_u,
  SysUtils;

procedure Showsyntax;
begin
  writeln('DFMConvert 1.0'#13#10'Converts a binary DFM to text-dfm.'#13#10'File will be replaced after *.bak file is written'#13#10'Syntax: DFMConvert filename.dfm');
  halt(0);
end;

procedure InvalidDFM;
begin
  writeln('invalid or non-binary input file');
  halt(1);
end;


var
  s: string;
  bin: boolean;

begin
  if (paramcount = 0) or (not fileexists(paramstr(1)) then begin
    showsyntax;
  end;
  s := file2string(paramstr(1));
  if (length(s) = 0) or (s[1] <> #255) then begin
    InvalidDFM;
  end;
  createbackup(paramstr(1));
  bin:=dfmparse_u.loaddfmFile(fn,sl); // <- grummel
  if not bin then InvalidDFM;
  dfmparse_u.SaveDFMFile(fn,sl,false); // <- grummel 2


end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:

program dfmconvert;
// saves a binary DFM file as text.
{$APPTYPE CONSOLE}

uses
  fastmm4,
  windows,
  classes,
  SysUtils;

procedure Showsyntax;
begin
  writeln('DFMConvert 1.0'#13#10'Converts a binary DFM to text-dfm.'#13#10'File will be replaced after *.bak file is written'#13#10'Syntax: DFMConvert filename.dfm');
  halt(0);
end;

procedure InvalidDFM;
begin
  writeln('invalid or non-binary input file');
  halt(1);
end;


var
  c : char;
  f : file of char;
  ins : TFileStream;
  ous : TMemoryStream;

begin
  if (paramcount = 0) or (not fileexists(paramstr(1))) then begin
    showsyntax;
  end;
  assignfile(f,paramstr(1));
  reset(f);
  if filesize(f) = 0  then c := #0 else read(f,c);
  closefile(f);
  if (c <> #255) then InvalidDFM;
  CopyFile(pchar(paramstr(1)),pchar(paramstr(1) + '.bak'),false);
  ins := TFileStream.Create(paramstr(1),fmOpenRead or fmShareDenyNone);
  ous := TMemoryStream.Create;
  ObjectResourceToText(ins, ous);
  ins.Free;
  ous.SaveToFile(paramstr(1));
  ous.Free;
end.