claform.pas

Delphi高级开发指南是开发程序的好帮手

  AddType (TypeInfo (TMaskEdit));
  AddType (TypeInfo (TMediaPlayer));
  AddType (TypeInfo (TMemo));
  AddType (TypeInfo (TMemoField));
  AddType (TypeInfo (TMemoryStream));
  AddType (TypeInfo (TMenu));
  AddType (TypeInfo (TMenuItem));
  AddType (TypeInfo (TMetafile));
  AddType (TypeInfo (TMetafileCanvas));
  AddType (TypeInfo (TMethodProperty));
  AddType (TypeInfo (TModalResultProperty));
  AddType (TypeInfo (TMPFileNameProperty));
  AddType (TypeInfo (TNotebook));
  AddType (TypeInfo (TNotebook));
  AddType (TypeInfo (TObject));
  AddType (TypeInfo (TOleContainer));
  AddType (TypeInfo (TOpenDialog));
  AddType (TypeInfo (TOrdinalProperty));
  AddType (TypeInfo (TOutline));
  AddType (TypeInfo (TOutlineNode));
  AddType (TypeInfo (TPageControl));
  AddType (TypeInfo (TPaintBox));
  AddType (TypeInfo (TPanel));
  AddType (TypeInfo (TParaAttributes));
  AddType (TypeInfo (TParam));
  AddType (TypeInfo (TParams));
  AddType (TypeInfo (TPen));
  AddType (TypeInfo (TPersistent));
  AddType (TypeInfo (TPicture));
  AddType (TypeInfo (TPopupMenu));
  AddType (TypeInfo (TPrintDialog));
  AddType (TypeInfo (TPrinter));
  AddType (TypeInfo (TPrinterSetupDialog));
  AddType (TypeInfo (TProgressBar));
  AddType (TypeInfo (TPropertyEditor));
  AddType (TypeInfo (TQuery));
  AddType (TypeInfo (TRadioButton));
  AddType (TypeInfo (TRadioGroup));
  AddType (TypeInfo (TReader));
  AddType (TypeInfo (TRegIniFile));
  AddType (TypeInfo (TRegistry));
  AddType (TypeInfo (TReplaceDialog));
  AddType (TypeInfo (TResourceStream));
  AddType (TypeInfo (TRichEdit));
  AddType (TypeInfo (TSaveDialog));
  AddType (TypeInfo (TScreen));
  AddType (TypeInfo (TScrollBar));
  AddType (TypeInfo (TScrollBox));
  AddType (TypeInfo (TScrollingWinControl));
  AddType (TypeInfo (TSession));
  AddType (TypeInfo (TSetElementProperty));
  AddType (TypeInfo (TSetProperty));
  AddType (TypeInfo (TShape));
  AddType (TypeInfo (TShape));
  AddType (TypeInfo (TShortCutProperty));
  AddType (TypeInfo (TSmallIntField));
  AddType (TypeInfo (TSpeedButton));
  AddType (TypeInfo (TStatusBar));
  AddType (TypeInfo (TStatusPanel));
  AddType (TypeInfo (TStatusPanels));
  AddType (TypeInfo (TStoredProc));
  AddType (TypeInfo (TStream));
  AddType (TypeInfo (TStringField));
  AddType (TypeInfo (TStringList));
  AddType (TypeInfo (TStringProperty));
  AddType (TypeInfo (TStrings));
  AddType (TypeInfo (TStringGrid));
  AddType (TypeInfo (TTabbedNotebook));
  AddType (TypeInfo (TTabControl));
  AddType (TypeInfo (TTable));
  AddType (TypeInfo (TTabOrderProperty));
  AddType (TypeInfo (TTabSet));
  AddType (TypeInfo (TTabSheet));
  AddType (TypeInfo (TTextAttributes));
  AddType (TypeInfo (TThread));
  AddType (TypeInfo (TTimeField));
  AddType (TypeInfo (TTimer));
  AddType (TypeInfo (TTrackBar));
  AddType (TypeInfo (TTreeNode));
  AddType (TypeInfo (TTreeNodes));
  AddType (TypeInfo (TTreeView));
  AddType (TypeInfo (TUpdateSQL));
  AddType (TypeInfo (TUpDown));
  AddType (TypeInfo (TVarBytesField));
  AddType (TypeInfo (TWinControl));
  AddType (TypeInfo (TWordField));
  AddType (TypeInfo (TWriter));
  AddType (TypeInfo (Exception));
  AddType (TypeInfo (EAbort));
  AddType (TypeInfo (EAccessViolation));
  AddType (TypeInfo (EControlC));
  AddType (TypeInfo (EConvertError));
  AddType (TypeInfo (EDivByZero));
  AddType (TypeInfo (EExternalException));
  AddType (TypeInfo (EInOutError));
  AddType (TypeInfo (EIntError));
  AddType (TypeInfo (EIntOverFlow));
  AddType (TypeInfo (EInvalidCast));
  AddType (TypeInfo (EInvalidOp));
  AddType (TypeInfo (EInvalidPointer));
  AddType (TypeInfo (EMathError));
  AddType (TypeInfo (EOutOfMemory));
  AddType (TypeInfo (EOverflow));
  AddType (TypeInfo (EPrivilege));
  AddType (TypeInfo (EPropReadOnly));
  AddType (TypeInfo (EPropWriteOnly));
  AddType (TypeInfo (ERangeError));
  AddType (TypeInfo (EStackOverflow));
  AddType (TypeInfo (EUnderflow));
  AddType (TypeInfo (EVariantError));
  AddType (TypeInfo (EZeroDivide));
end;

// code extracted from TypInfo.pas
procedure SortPropList(PropList: PPropList; PropCount: Integer); assembler;
asm
        { ->    EAX Pointer to prop list        }
        {       EDX Property count              }
        { <-    nothing                         }

        PUSH    EBX
        PUSH    ESI
        PUSH    EDI
        MOV     ECX,EAX
        XOR     EAX,EAX
        DEC     EDX
        CALL    @@qsort
        POP     EDI
        POP     ESI
        POP     EBX
        JMP     @@exit

@@qsort:
        PUSH    EAX
        PUSH    EDX
        LEA     EDI,[EAX+EDX]           { pivot := (left + right) div 2 }
        SHR     EDI,1
        MOV     EDI,[ECX+EDI*4]
        ADD     EDI,OFFSET TPropInfo.Name
@@repeat:                               { repeat                        }
@@while1:
        CALL    @@compare               { while a[i] < a[pivot] do inc(i);}
        JAE     @@endWhile1
        INC     EAX
        JMP     @@while1
@@endWhile1:
        XCHG    EAX,EDX
@@while2:
        CALL    @@compare               { while a[j] > a[pivot] do dec(j);}
        JBE     @@endWhile2
        DEC     EAX
        JMP     @@while2
@@endWhile2:
        XCHG    EAX,EDX
        CMP     EAX,EDX                 { if i <= j then begin          }
        JG      @@endRepeat
        MOV     EBX,[ECX+EAX*4]         { x := a[i];                    }
        MOV     ESI,[ECX+EDX*4]         { y := a[j];                    }
        MOV     [ECX+EDX*4],EBX         { a[j] := x;                    }
        MOV     [ECX+EAX*4],ESI         { a[i] := y;                    }
        INC     EAX                     { inc(i);                       }
        DEC     EDX                     { dec(j);                       }
                                        { end;                          }
        CMP     EAX,EDX                 { until i > j;                  }
        JLE     @@repeat

@@endRepeat:
        POP     ESI
        POP     EBX

        CMP     EAX,ESI
        JL      @@rightNonEmpty         { if i >= right then begin      }
        CMP     EDX,EBX
        JG      @@leftNonEmpty1         { if j <= left then exit        }
        RET

@@leftNonEmpty1:
        MOV     EAX,EBX
        JMP     @@qsort                 { qsort(left, j)                }

@@rightNonEmpty:
        CMP     EAX,EBX
        JG      @@leftNonEmpty2
        MOV     EDX,ESI                 { qsort(i, right)               }
        JMP     @@qsort
@@leftNonEmpty2:
        PUSH    EAX
        PUSH    ESI
        MOV     EAX,EBX
        CALL    @@qsort                 { qsort(left, j)                }
        POP     EDX
        POP     EAX
        JMP     @@qsort                 { qsort(i, right)               }

@@compare:
        PUSH    EAX
        PUSH    EDI
        MOV     ESI,[ECX+EAX*4]
        ADD     ESI,OFFSET TPropInfo.Name
        PUSH    ESI
        XOR     EBX,EBX
        MOV     BL,[ESI]
        INC     ESI
        CMP     BL,[EDI]
        JBE     @@firstLenSmaller
        MOV     BL,[EDI]
@@firstLenSmaller:
        INC     EDI
        TEST    BL,BL
        JE      @@endLoop
@@loop:
        MOV     AL,[ESI]
        MOV     AH,[EDI]
        AND     EAX,$DFDF
        CMP     AL,AH
        JNE     @@difference
        INC     ESI
        INC     EDI
        DEC     EBX
        JNZ     @@loop
@@endLoop:
        POP     ESI
        POP     EDI
        MOV     AL,[ESI]
        MOV     AH,[EDI]
        CMP     AL,AH
        POP     EAX
        RET
@@difference:
        POP     ESI
        POP     EDI
        POP     EAX
        RET
@@exit:
end;

procedure TForm1.ListBox2Click(Sender: TObject);
var
  Text: string;
  Index: Integer;
  pti: PTypeInfo;
begin
  // get the current item
  Text := ListBox2.Items [ListBox2.ItemIndex];
  // search the first listbox
  Index := ListBox1.Items.IndexOf (Text);
  // if found, it was a parent class: show RTTI
  if Index >= 0 then
  begin
    pti := PTypeInfo (ListBox1.Items.Objects [Index]);
    Caption := 'RTTI information for ' + Text;
    ListBox2.Items.Clear;
    ShowClass (pti, ListBox2.Items);
  end;
end;

end.