commit a5cf23eda40dd2c5d924ae5f48aaa9bca9e8c123 Author: Nikolaos Georgiou Date: Sat May 29 07:57:12 2021 +0200 Add 'pas/' from commit '71642f0773f3b21b1e6bcdfcfdbdb186b6c8f78c' git-subtree-dir: pas git-subtree-mainline: 6d5784cc4089eeb4864244cd4951b1aa66b4e90e git-subtree-split: 71642f0773f3b21b1e6bcdfcfdbdb186b6c8f78c diff --git a/Chameleon.dof b/Chameleon.dof new file mode 100644 index 0000000..9d48bcd --- /dev/null +++ b/Chameleon.dof @@ -0,0 +1,87 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages= +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1033 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= diff --git a/Chameleon.lpi b/Chameleon.lpi new file mode 100644 index 0000000..a7f94b7 --- /dev/null +++ b/Chameleon.lpi @@ -0,0 +1,116 @@ + + + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="7"> + <Unit0> + <Filename Value="Chameleon.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="frmMain.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + <Unit2> + <Filename Value="frmResults.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Results"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit2> + <Unit3> + <Filename Value="Writers.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="DfmEngine.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="StrConsts.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="about1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="AboutBox"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit6> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/Chameleon.lpr b/Chameleon.lpr new file mode 100644 index 0000000..94bfe3d --- /dev/null +++ b/Chameleon.lpr @@ -0,0 +1,24 @@ +program Chameleon; + +{$MODE Delphi} + +uses + Forms, + Interfaces, + frmMain in 'frmMain.pas' {MainForm}, + frmResults in 'frmResults.pas' {Results}, + Writers in 'Writers.pas', + DfmEngine in 'DfmEngine.pas', + StrConsts in 'StrConsts.pas', + about1 in 'about1.pas' {AboutBox}; + + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.CreateForm(TResults, Results); + Application.CreateForm(TAboutBox, AboutBox); + Application.Run; +end. diff --git a/Chameleon.res b/Chameleon.res new file mode 100644 index 0000000..d5ab174 Binary files /dev/null and b/Chameleon.res differ diff --git a/DfmEngine.pas b/DfmEngine.pas new file mode 100644 index 0000000..544436c --- /dev/null +++ b/DfmEngine.pas @@ -0,0 +1,444 @@ +unit DfmEngine; + +{$MODE Delphi} + +interface + +uses Windows, Messages, SysUtils, Classes, Forms, Graphics, + Writers; + +type + PEnumParams = ^TEnumParams; + + TEnumParams = record + List: TList; + ParentWnd: HWND; + end; + + TKnownControl = ( + kcUnknown, kcButton, kcCheckBox, kcComboBox, kcEdit, + kcGroupBox, kcImage, kcLabel, kcListBox, kcListView, + kcPanel, kcRadioButton, kcStatusBar, kcTreeView + ); + TKnownControls = set of TKnownControl; + TKnownControlHandlerProc = procedure(wnd: HWND; style: integer) of object; + + TDfmBuilder = class + private + PasList: TStrings; + dfm1: TDfmWriter; + Counts: array[TKnownControl] of integer; + CtlType: TKnownControl; + procedure DispatchHandle(wnd: HWND; style: integer); + procedure HandleUnknown(wnd: HWND; style: integer); + procedure HandleButton(wnd: HWND; style: integer); + procedure HandleCheckBox(wnd: HWND; style: integer); + procedure HandleComboBox(wnd: HWND; style: integer); + procedure HandleEdit(wnd: HWND; style: integer); + procedure HandleGroupBox(wnd: HWND; style: integer); + procedure HandleImage(wnd: HWND; style: integer); + procedure HandleLabel(wnd: HWND; style: integer); + procedure HandleListBox(wnd: HWND; style: integer); + procedure HandleListView(wnd: HWND; style: integer); + procedure HandlePanel(wnd: HWND; style: integer); + procedure HandleRadioButton(wnd: HWND; style: integer); + procedure HandleStatusBar(wnd: HWND; style: integer); + procedure HandleTreeView(wnd: HWND; style: integer); + procedure PreHandleCtl(wnd: HWND); + procedure WriteDecl; + public + constructor Create(APasList: TStrings); + procedure Build(OutStream: TStream; const frmName: string; wnd: HWND); + end; + +const + KCNames: array[TKnownControl] of string = ( + 'Unknown', 'Button', 'CheckBox', 'ComboBox', 'Edit', + 'GroupBox', 'Image', 'Label', 'ListBox', 'ListView', + 'Panel', 'RadioButton', 'StatusBar', 'TreeView' + ); + + KCClassNames: array[TKnownControl] of string = ( + 'TPanel', 'TButton', 'TCheckBox', 'TComboBox', 'TEdit', + 'TGroupBox', 'TImage', 'TLabel', 'TListBox', 'TListView', + 'TPanel', 'TRadioButton', 'TStatusBar', 'TTreeView' + ); + +function BitTest(Value, Mask: integer): boolean; +function GetWndText(wnd: HWND): string; +function EnumChildrenProc(wnd: HWND; lp: LPARAM): BOOL; stdcall; +procedure WriteBitmapData(dfm1: TDfmWriter; bmp: HBITMAP; + BelongsToPicture: boolean; const Name: string); +procedure WriteIconData(dfm1: TDfmWriter; icon: HICON; BelongsToPicture: boolean; + const Name: string); + +implementation + +function BitTest(Value, Mask: integer): boolean; +begin + Result := (Value and Mask) = Mask; +end; + +function GetWndText(wnd: HWND): string; +var + len: integer; +begin + len := GetWindowTextLength(wnd); + SetLength(Result, len); + GetWindowText(wnd, PChar(Result), len + 1); +end; + +function EnumChildrenProc(wnd: HWND; lp: LPARAM): BOOL; stdcall; +var + p: PEnumParams; +begin + p := PEnumParams(lp); + if GetParent(wnd) = p^.ParentWnd then + p^.List.Add(Pointer(wnd)); + Result := True; +end; + +function GetBorderIconsStr(ABorderIcons: TBorderIcons): string; +const + biStr: array [TBorderIcon] of string = ( + 'biSystemMenu', 'biMinimize', 'biMaximize', 'biHelp'); +var + k: TBorderIcon; +begin + if ABorderIcons = [] then + begin + Result := '[]'; + Exit; + end; + Result := '['; + for k := biSystemMenu to biHelp do + if k in ABorderIcons then + Result := Result + biStr[k] + ','; + Result[Length(Result)] := ']'; +end; + + +constructor TDfmBuilder.Create(APasList: TStrings); +begin + inherited Create; + PasList := APasList; +end; + +procedure TDfmBuilder.Build(OutStream: TStream; const frmName: string; wnd: HWND); +var + InStream: TMemoryStream; + childlist: TList; + i: integer; + style, exstyle: longint; + wndX: HWND; + EnumParams: TEnumParams; + + procedure WriteBorderIcons; + var + bi: TBorderIcons; + s: string; + begin + bi := []; + if BitTest(style, WS_SYSMENU) then + Include(bi, biSystemMenu); + if BitTest(style, WS_MINIMIZEBOX) then + Include(bi, biMinimize); + if BitTest(style, WS_MAXIMIZEBOX) then + Include(bi, biMaximize); + if BitTest(exstyle, WS_EX_CONTEXTHELP) then + Include(bi, biHelp); + s := GetBorderIconsStr(bi); + dfm1.WriteCustomProp('BorderIcons', s); + end; + +begin + // Initialize + FillChar(Counts, sizeof(Counts), #0); + InStream := TMemoryStream.Create; + Dfm1 := TDfmWriter.Create(InStream); + childlist := TList.Create; + + dfm1.WriteLn('object ' + frmName + ': T' + frmName); + exstyle := GetWindowLong(wnd, GWL_EXSTYLE); + dfm1.Ident := 2; + dfm1.WritePlacement(wnd, 0); + WriteBorderIcons; + dfm1.WriteStringProp('Caption', GetWndText(wnd)); + dfm1.WriteCustomProp('Font.Charset', 'GREEK_CHARSET'); + dfm1.WriteColorProp('Font.Color', clWindowText); + dfm1.WriteIntProp('Font.Height', -11); + dfm1.WriteStringProp('Font.Name', 'MS Sans Serif'); + dfm1.WriteCustomProp('Font.Style', '[]'); + WriteIconData(dfm1, SendMessage(wnd, WM_GETICON, 0, 0), False, 'Icon.Data'); + dfm1.WriteIntProp('PixelsPerInch', 96); + dfm1.WriteIntProp('TextHeight', 13); + + // write the children + EnumParams.List := childlist; + EnumParams.ParentWnd := wnd; + EnumChildWindows(wnd, @EnumChildrenProc, integer(@EnumParams)); + for i := 0 to childlist.Count - 1 do + begin + wndX := HWND(childlist[i]); + PreHandleCtl(wndX); + end; + dfm1.Ident := 0; + dfm1.WriteLn('end'); + InStream.Position := 0; + + ObjectTextToResource(InStream, OutStream); + + // finalization + childlist.Free; + DFM1.Free; +end; + +procedure TDfmBuilder.HandleUnknown(wnd: HWND; style: integer); +var + class_name: array [0..100] of char; + childlist: TList; + EnumParams: TEnumParams; + i: integer; +begin + // since we don't know what window we're after write the class name + GetClassName(wnd, class_name, 100); + dfm1.WriteStringProp('Caption', class_name); + childlist := TList.Create; + EnumParams.List := childlist; + EnumParams.ParentWnd := wnd; + EnumChildWindows(wnd, @EnumChildrenProc, integer(@EnumParams)); + for i := 0 to childlist.Count - 1 do + begin + PreHandleCtl(HWND(childlist[i])); + end; + childlist.Free; +end; + +procedure TDfmBuilder.HandleButton(wnd: HWND; style: integer); +begin + dfm1.WriteStringProp('Caption', GetWndText(wnd)); + dfm1.WriteBoolProp('Default', BitTest(style, BS_DEFPUSHBUTTON)); +end; + +procedure TDfmBuilder.HandleCheckBox(wnd: HWND; style: integer); +const + CheckedStr: array [0..2] of string = ('cbUnchecked', 'cbChecked', 'cbGrayed'); +var + state: integer; + allowgrayed: boolean; +begin + allowgrayed := BitTest(style, BS_3STATE) or BitTest(style, BS_AUTO3STATE); + state := SendMessage(wnd, BM_GETCHECK, 0, 0); + dfm1.WriteBoolProp('AllowGrayed', allowgrayed); + dfm1.WriteStringProp('Caption', GetWndText(wnd)); + dfm1.WriteCustomProp('State', CheckedStr[state]); +end; + +procedure TDfmBuilder.HandleComboBox(wnd: HWND; style: integer); +begin +end; + +procedure TDfmBuilder.HandleEdit(wnd: HWND; style: integer); +begin + dfm1.WriteStringProp('Text', GetWndText(wnd)); +end; + +procedure TDfmBuilder.HandleGroupBox(wnd: HWND; style: integer); +begin +end; + +procedure TDfmBuilder.HandleImage(wnd: HWND; style: integer); +var + h: THANDLE; + OnlyIcon: boolean; +begin + OnlyIcon := BitTest(style, SS_ICON); + if OnlyIcon then + begin + h := SendMessage(wnd, STM_GETICON, 0, 0); + WriteIconData(dfm1, h, True, 'Picture.Data'); + end + else + begin + h := SendMessage(wnd, STM_GETIMAGE, IMAGE_BITMAP, 0); + if h <> 0 then + WriteBitmapData(dfm1, h, True, 'Picture.Data') + else + begin + h := SendMessage(wnd, STM_GETIMAGE, IMAGE_ICON, 0); + WriteIconData(dfm1, h, True, 'Picture.Data'); + end; + end; +end; + +procedure TDfmBuilder.HandleLabel(wnd: HWND; style: integer); +begin + dfm1.WriteBoolProp('AutoSize', False); + dfm1.WriteStringProp('Caption', GetWndText(wnd)); + dfm1.WriteBoolProp('WordWrap', True); +end; + +procedure TDfmBuilder.HandleListBox(wnd: HWND; style: integer); +begin +end; + +procedure TDfmBuilder.HandleListView(wnd: HWND; style: integer); +begin +end; + +procedure TDfmBuilder.HandlePanel(wnd: HWND; style: integer); +begin +end; + +procedure TDfmBuilder.HandleRadioButton(wnd: HWND; style: integer); +begin +end; + +procedure TDfmBuilder.HandleStatusBar(wnd: HWND; style: integer); +begin +end; + +procedure TDfmBuilder.HandleTreeView(wnd: HWND; style: integer); +begin +end; + +procedure WriteBitmapData(dfm1: TDfmWriter; bmp: HBITMAP; + BelongsToPicture: boolean; const Name: string); +var + b: TBitmap; + Memory: TTextWriter; + Size, Offset: integer; +begin + b := TBitmap.Create; + Memory := TTextWriter.Create(TMemoryStream.Create); + try + b.Handle := CopyImage(bmp, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG); + + if BelongsToPicture then + Memory.WriteString('TBitmap'); + size := 0; + Offset := Memory.Stream.Position; + Memory.Stream.Write(size, SizeOf(size)); + b.SaveToStream(Memory.Stream); + Memory.Stream.Position := Offset; + size := Memory.Stream.Size - sizeof(size) - Offset; + Memory.Stream.Write(size, SizeOf(size)); + Memory.Stream.Position := 0; + + dfm1.Write(Name + ' = {'); + dfm1.Ident := dfm1.Ident + 2; + dfm1.WriteBinaryAsText(Memory.Stream); + dfm1.Ident := dfm1.Ident - 2; + dfm1.WriteLn('}'); + finally + b.Handle := 0; + b.Free; + Memory.Free; + end; +end; + +procedure WriteIconData(dfm1: TDfmWriter; icon: HICON; BelongsToPicture: boolean; + const Name: string); +var + i: TIcon; + k: TTextWriter; +begin + if icon = 0 then + Exit; + i := TIcon.Create; + k := TTextWriter.Create(TMemoryStream.Create); + try + i.Handle := CopyIcon(icon); + if BelongsToPicture then + k.WriteString('TIcon'); + i.SaveToStream(k.Stream); + k.Stream.Position := 0; + + dfm1.Write(Name + ' = {'); + dfm1.Ident := dfm1.Ident + 2; + dfm1.WriteBinaryAsText(k.Stream); + dfm1.WriteLn('}'); + dfm1.Ident := dfm1.Ident - 2; + + finally + i.Free; + k.Free; + end; +end; + +procedure TDfmBuilder.WriteDecl; +var + s: string; +begin + Inc(Counts[CtlType]); + s := KCNames[CtlType] + IntToStr(Counts[CtlType]) + ': ' + KCClassNames[CtlType]; + PasList.Add(s + ';'); + dfm1.WriteLn('object ' + s); + dfm1.Ident := dfm1.Ident + 2; +end; + +procedure TDfmBuilder.DispatchHandle(wnd: HWND; style: integer); +begin + case CtlType of + kcUnknown: HandleUnknown(wnd, style); + kcButton: HandleButton(wnd, style); + kcCheckBox: HandleCheckBox(wnd, style); + kcComboBox: HandleComboBox(wnd, style); + kcEdit: HandleEdit(wnd, style); + kcGroupBox: HandleGroupBox(wnd, style); + kcImage: HandleImage(wnd, style); + kcLabel: HandleLabel(wnd, style); + kcListBox: HandleListBox(wnd, style); + kcListView: HandleListView(wnd, style); + kcPanel: HandlePanel(wnd, style); + kcRadioButton: HandleRadioButton(wnd, style); + kcStatusBar: HandleStatusBar(wnd, style); + kcTreeView: HandleTreeView(wnd, style); + end; +end; + +procedure TDfmBuilder.PreHandleCtl(wnd: HWND); +var + class_name: array [0..100] of char; + style: integer; +begin + GetClassName(wnd, class_name, 100); + style := GetWindowLong(wnd, GWL_STYLE); + if StrIComp(class_name, 'Static') = 0 then + begin + if BitTest(style, SS_BITMAP) or BitTest(style, SS_ICON) then + CtlType := kcImage + else + CtlType := kcLabel; + end + else if StrIComp(class_name, 'Button') = 0 then + begin + if BitTest(style, BS_GROUPBOX) then + CtlType := kcGroupBox + else if BitTest(style, BS_RADIOBUTTON) or BitTest(style, BS_AUTORADIOBUTTON) then + CtlType := kcRadioButton + else if BitTest(style, BS_CHECKBOX) or BitTest(style, BS_AUTOCHECKBOX) or + BitTest(style, BS_3STATE) or BitTest(style, BS_AUTO3STATE) then + CtlType := kcCheckBox + else + CtlType := kcButton; + end + else if StrIComp(class_name, 'ComboBox') = 0 then + CtlType := kcComboBox + else if StrIComp(class_name, 'ListBox') = 0 then + CtlType := kcListBox + else if StrIComp(class_name, 'Edit') = 0 then + CtlType := kcEdit + else if StrIComp(class_name, 'msctls_statusbar32') = 0 then + CtlType := kcStatusBar + else + CtlType := kcUnknown; + + WriteDecl; + dfm1.WritePlacement(wnd, GetParent(wnd)); + DispatchHandle(wnd, style); + dfm1.Ident := dfm1.Ident - 2; + dfm1.WriteLn('end'); +end; + +end. diff --git a/README.md b/README.md new file mode 100644 index 0000000..1041ea0 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +# Chameleon +A Delphi app that can replicate any window from any other program and generate a Delphi form that looks identical (legacy project, Windows only) diff --git a/StrConsts.pas b/StrConsts.pas new file mode 100644 index 0000000..e34fef1 --- /dev/null +++ b/StrConsts.pas @@ -0,0 +1,106 @@ +unit StrConsts; + +{$MODE Delphi} + +interface + +uses Windows; + +const + WindowStyle: array [0..21] of DWORD = ( + WS_BORDER, + WS_CAPTION, + WS_CHILD, + WS_CLIPCHILDREN, + WS_CLIPSIBLINGS, + WS_DISABLED, + WS_DLGFRAME, + WS_GROUP, + WS_HSCROLL, + WS_MAXIMIZE, + WS_MAXIMIZEBOX, + WS_MINIMIZE, + WS_MINIMIZEBOX, + WS_OVERLAPPED, + WS_OVERLAPPEDWINDOW, + WS_POPUP, + WS_POPUPWINDOW, + WS_SYSMENU, + WS_TABSTOP, + WS_THICKFRAME, + WS_VISIBLE, + WS_VSCROLL); + + WindowStyleName: array [0..21] of string = ( + 'Border', + 'Caption', + 'Child', + 'Clip children', + 'Clip siblings', + 'Disabled', + 'Dialog frame', + 'Group', + 'Horizontal scroll bar', + 'Maximized', + 'Maximize button', + 'Minimized', + 'Minimize button', + 'Overlapped', + 'Overlapped window', + 'Pop-up', + 'Pop-up window', + 'System menu', + 'Tab stop', + 'Sizing frame', + 'Visible', + 'Vertical scroll bar'); + + ExtendedWindowStyle: array [0..20] of integer = ( + WS_EX_ACCEPTFILES, + WS_EX_APPWINDOW, + WS_EX_CLIENTEDGE, + WS_EX_CONTEXTHELP, + WS_EX_CONTROLPARENT, + WS_EX_DLGMODALFRAME, + WS_EX_LEFT, + WS_EX_LEFTSCROLLBAR, + WS_EX_LTRREADING, + WS_EX_MDICHILD, + WS_EX_NOPARENTNOTIFY, + WS_EX_OVERLAPPEDWINDOW, + WS_EX_PALETTEWINDOW, + WS_EX_RIGHT, + WS_EX_RIGHTSCROLLBAR, + WS_EX_RTLREADING, + WS_EX_STATICEDGE, + WS_EX_TOOLWINDOW, + WS_EX_TOPMOST, + WS_EX_TRANSPARENT, + WS_EX_WINDOWEDGE); + + ExtendedWindowStyleName: array [0..20] of string = ( + 'Drag drop recepient', + 'Minimize on taskbar', + 'Sunken edge border', + 'Context help', + 'TAB key navigation', + 'Double border', + 'Left aligned (default)', + 'Left vertical scrollbar', + 'Left to Right Text (default)', + 'MDI Child', + 'No parent notify', + 'Client & Window edge', + 'Window & ToolWindow & TopMost edge', + 'Right aligned', + 'Right vertical scrollbar (default)', + 'Right to Left text', + 'Static edge', + 'Tool window', + 'Topmost', + 'Transparent', + 'Raised edge'); + +implementation + +end. diff --git a/Writers.pas b/Writers.pas new file mode 100644 index 0000000..1926942 --- /dev/null +++ b/Writers.pas @@ -0,0 +1,190 @@ +unit Writers; + +{$MODE Delphi} + +interface + +uses Windows, SysUtils, Classes, Graphics; + +type + TTextWriter = class + private + FStream: TStream; + FIdent: cardinal; + FWriteIdent: boolean; + procedure WriteIdent; + public + constructor Create(AStream: TStream); + constructor CreateFile(const FileName: string); + destructor Destroy; override; + procedure NewLine; + procedure Write(const str: string); + procedure WriteLn(const str: string); + procedure WriteString(const str: string); + property Ident: cardinal read FIdent write FIdent; + property Stream: TStream read FStream; + end; + + TDfmWriter = class(TTextWriter) + procedure WriteBinaryAsText(Input: TStream); + procedure WriteBoolProp(const Name: string; Value: boolean); + procedure WriteColorProp(const Name: string; Value: TColor); + procedure WriteCustomProp(const Name, Value: string); + procedure WriteIntProp(const Name: string; Value: integer); + procedure WriteStringProp(const Name, Value: string); + procedure WritePlacement(wnd, parent: HWND); + end; + +implementation + +constructor TTextWriter.Create(AStream: TStream); +begin + inherited Create; + FStream := AStream; + FIdent := 0; + FWriteIdent := True; +end; + +constructor TTextWriter.CreateFile(const FileName: string); +begin + inherited Create; + FStream := TFileStream.Create(FileName, fmCreate); + FIdent := 0; + FWriteIdent := True; +end; + +destructor TTextWriter.Destroy; +begin + FStream.Free; + inherited; +end; + +procedure TTextWriter.WriteIdent; +var + s: string; + i: integer; +begin + if FWriteIdent then + begin + if FIdent > 0 then + begin + s := ''; + for i := 1 to FIdent do + s := s + ' '; + FStream.Write(s[1], FIdent); + end; + FWriteIdent := False; + end; +end; + +procedure TTextWriter.Write(const str: string); +begin + WriteIdent; + FStream.Write(str[1], Length(str)); +end; + +procedure TTextWriter.WriteLn(const str: string); +begin + Write(str); + NewLine; +end; + +procedure TTextWriter.WriteString(const str: string); +begin + Write(Chr(Length(str)) + str); +end; + +procedure TTextWriter.NewLine; +const + crlf: array [0..1] of char = #13#10; +begin + FStream.Write(crlf[0], 2); + FWriteIdent := True; +end; + +procedure TDfmWriter.WriteBoolProp(const Name: string; Value: boolean); +const + s: array [False..True] of string = ('False', 'True'); +begin + WriteCustomProp(Name, s[Value]); +end; + +procedure TDfmWriter.WriteColorProp(const Name: string; Value: TColor); +begin + WriteCustomProp(Name, ColorToString(Value)); +end; + +procedure TDfmWriter.WriteCustomProp(const Name, Value: string); +begin + WriteLn(Name + ' = ' + Value); +end; + +procedure TDfmWriter.WriteIntProp(const Name: string; Value: integer); +begin + WriteCustomProp(Name, IntToStr(Value)); +end; + +procedure TDfmWriter.WriteStringProp(const Name, Value: string); +begin + WriteCustomProp(Name, '''' + Value + ''''); +end; + +procedure BinToHex(Binary, Text: PChar; Count: integer); +const + HexChars: array[0..15] of char = '0123456789ABCDEF'; +var + I: integer; +begin + for I := 0 to Count - 1 do + begin + Text^ := HexChars[(byte(Binary[I]) and $F0) shr 4]; + Inc(Text); + Text^ := HexChars[(byte(Binary[I]) and $0F)]; + Inc(Text); + end; +end; + +procedure TDfmWriter.WriteBinaryAsText(Input: TStream); +const + BytesPerLine = 32; +var + MultiLine: boolean; + I: integer; + Count: longint; + Buffer: array[0..BytesPerLine - 1] of char; + Text: array[0..BytesPerLine * 2 - 1] of char; +begin + Count := Input.Size; + MultiLine := Count > BytesPerLine; + while Count > 0 do + begin + if MultiLine then + NewLine; + if Count >= BytesPerLine then + I := BytesPerLine + else + I := Count; + Input.Read(Buffer, I); + BinToHex(Buffer, Text, I); + Write(Text); + Dec(Count, I); + end; +end; + +procedure TDfmWriter.WritePlacement(wnd, parent: HWND); +var + R: TRect; +begin + GetWindowRect(wnd, R); + if IsWindow(parent) then + begin + Windows.ScreenToClient(parent, R.TopLeft); + Windows.ScreenToClient(parent, R.BottomRight); + end; + WriteIntProp('Left', R.Left); + WriteIntProp('Top', R.Top); + WriteIntProp('Width', R.Right - R.Left); + WriteIntProp('Height', R.Bottom - R.Top); +end; + +end. diff --git a/about1.lfm b/about1.lfm new file mode 100644 index 0000000..dec5d42 --- /dev/null +++ b/about1.lfm @@ -0,0 +1,94 @@ +object AboutBox: TAboutBox + Left = 910 + Height = 326 + Top = 703 + Width = 361 + BorderStyle = bsDialog + Caption = 'About' + ClientHeight = 326 + ClientWidth = 361 + DesignTimePPI = 168 + Font.Color = clWindowText + Font.Height = -24 + Font.Name = 'Tahoma' + Position = poScreenCenter + LCLVersion = '1.8.0.6' + object Panel1: TPanel + Left = 20 + Height = 200 + Top = 20 + Width = 320 + BevelInner = bvRaised + BevelOuter = bvLowered + ClientHeight = 200 + ClientWidth = 320 + TabOrder = 0 + object ProductName: TLabel + Left = 20 + Height = 29 + Top = 20 + Width = 117 + Alignment = taCenter + Caption = 'Chameleon' + Font.CharSet = GREEK_CHARSET + Font.Color = clWindowText + Font.Height = -24 + Font.Name = 'Tahoma' + ParentColor = False + ParentFont = False + end + object Version: TLabel + Left = 20 + Height = 29 + Top = 60 + Width = 139 + Alignment = taCenter + Caption = 'Version 0.0.2' + Font.CharSet = GREEK_CHARSET + Font.Color = clWindowText + Font.Height = -24 + Font.Name = 'Tahoma' + ParentColor = False + ParentFont = False + end + object Copyright: TLabel + Left = 20 + Height = 29 + Top = 100 + Width = 231 + Alignment = taCenter + Caption = '(C) Nikolaos Georgiou' + Font.CharSet = GREEK_CHARSET + Font.Color = clWindowText + Font.Height = -24 + Font.Name = 'Tahoma' + ParentColor = False + ParentFont = False + end + object Comments: TLabel + Left = 20 + Height = 29 + Top = 140 + Width = 128 + Alignment = taCenter + Caption = 'MIT License' + Font.CharSet = GREEK_CHARSET + Font.Color = clWindowText + Font.Height = -24 + Font.Name = 'Tahoma' + ParentColor = False + ParentFont = False + WordWrap = True + end + end + object OKButton: TButton + Left = 110 + Height = 65 + Top = 240 + Width = 140 + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 1 + end +end diff --git a/about1.pas b/about1.pas new file mode 100644 index 0000000..59adb3d --- /dev/null +++ b/about1.pas @@ -0,0 +1,32 @@ +unit about1; + +{$MODE Delphi} + +interface + +uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, + Buttons, ExtCtrls; + +type + TAboutBox = class(TForm) + Panel1: TPanel; + ProductName: TLabel; + Version: TLabel; + Copyright: TLabel; + Comments: TLabel; + OKButton: TButton; + private + { Private declarations } + public + { Public declarations } + end; + +var + AboutBox: TAboutBox; + +implementation + +{$R *.lfm} + +end. + \ No newline at end of file diff --git a/frmMain.lfm b/frmMain.lfm new file mode 100644 index 0000000..a592d88 --- /dev/null +++ b/frmMain.lfm @@ -0,0 +1,228 @@ +object MainForm: TMainForm + Left = 645 + Height = 522 + Top = 560 + Width = 750 + BorderIcons = [biSystemMenu] + BorderStyle = bsSingle + Caption = 'Chameleon' + ClientHeight = 522 + ClientWidth = 750 + Color = clBtnFace + DesignTimePPI = 168 + Font.Color = clWindowText + Font.Height = -24 + Font.Name = 'Tahoma' + LCLVersion = '1.8.0.6' + object lblDelayTime: TLabel + Left = 36 + Height = 29 + Top = 20 + Width = 294 + Caption = 'Time until restoring control:' + ParentColor = False + end + object Label1: TLabel + Left = 478 + Height = 29 + Top = 20 + Width = 55 + Caption = 'msec' + ParentColor = False + end + object DelayTime: TSpinEdit + Left = 360 + Height = 37 + Top = 20 + Width = 111 + MaxValue = 0 + TabOrder = 0 + Value = 3000 + end + object PageControl1: TPageControl + Left = 36 + Height = 396 + Top = 100 + Width = 692 + ActivePage = InformationSheet + TabIndex = 0 + TabOrder = 1 + object InformationSheet: TTabSheet + Caption = 'Get information' + ClientHeight = 354 + ClientWidth = 684 + object lblWndValue: TLabel + Left = 56 + Height = 29 + Top = 160 + Width = 134 + Caption = 'HWND value' + Enabled = False + ParentColor = False + end + object Information: TButton + Left = 36 + Height = 72 + Top = 240 + Width = 504 + Caption = 'Get information' + OnClick = InformationClick + TabOrder = 3 + end + object WndValue: TEdit + Left = 223 + Height = 37 + Top = 160 + Width = 121 + Enabled = False + TabOrder = 2 + end + object optAutomatic: TRadioButton + Left = 24 + Height = 33 + Top = 20 + Width = 185 + Caption = 'Select window' + Checked = True + OnClick = optAutomaticClick + TabOrder = 0 + TabStop = True + end + object optManual: TRadioButton + Left = 24 + Height = 33 + Top = 100 + Width = 320 + Caption = 'Type in the window handle' + OnClick = optManualClick + TabOrder = 1 + end + end + object DelphiFormSheet: TTabSheet + Caption = 'Create Delphi form' + ClientHeight = 354 + ClientWidth = 684 + object Label3: TLabel + Left = 36 + Height = 29 + Top = 20 + Width = 148 + Caption = 'Unit file name' + ParentColor = False + end + object Label4: TLabel + Left = 36 + Height = 29 + Top = 140 + Width = 122 + Caption = 'Form name' + ParentColor = False + end + object PasFileName: TEdit + Left = 36 + Height = 37 + Top = 60 + Width = 324 + OnChange = PasEditChange + TabOrder = 0 + end + object BrowsePas: TButton + Left = 360 + Height = 37 + Top = 60 + Width = 144 + Caption = 'Browse...' + OnClick = BrowsePasClick + TabOrder = 1 + end + object FormName: TEdit + Left = 36 + Height = 37 + Top = 180 + Width = 468 + OnChange = PasEditChange + TabOrder = 2 + end + object SavePas: TButton + Left = 36 + Height = 72 + Top = 240 + Width = 468 + Caption = 'Select window and save it' + Enabled = False + OnClick = SavePasClick + TabOrder = 3 + end + end + object RCSheet: TTabSheet + Caption = 'Create resource script' + ClientHeight = 354 + ClientWidth = 684 + object Label2: TLabel + Left = 36 + Height = 29 + Top = 20 + Width = 135 + Caption = 'RC file name' + ParentColor = False + end + object RCFileName: TEdit + Left = 36 + Height = 37 + Top = 60 + Width = 293 + OnChange = RCFileNameChange + TabOrder = 0 + end + object BrowseRC: TButton + Left = 324 + Height = 37 + Top = 60 + Width = 144 + Caption = 'Browse...' + OnClick = BrowseRCClick + TabOrder = 1 + end + object SaveRC: TButton + Left = 36 + Height = 72 + Top = 180 + Width = 432 + Caption = 'Select window and save it' + Enabled = False + OnClick = SaveRCClick + TabOrder = 2 + end + end + end + object BitBtn1: TBitBtn + Left = 565 + Height = 64 + Top = 20 + Width = 163 + Caption = 'About...' + Glyph.Data = { + 76010000424D7601000000000000760000002800000020000000100000000100 + 04000000000000010000120B0000120B00001000000000000000000000000000 + 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333303333 + 333333333337FF3333333333330003333333333333777F333333333333080333 + 3333333F33777FF33F3333B33B000B33B3333373F777773F7333333BBB0B0BBB + 33333337737F7F77F333333BBB0F0BBB33333337337373F73F3333BBB0F7F0BB + B333337F3737F73F7F3333BB0FB7BF0BB3333F737F37F37F73FFBBBB0BF7FB0B + BBB3773F7F37337F377333BB0FBFBF0BB333337F73F333737F3333BBB0FBF0BB + B3333373F73FF7337333333BBB000BBB33333337FF777337F333333BBBBBBBBB + 3333333773FF3F773F3333B33BBBBB33B33333733773773373333333333B3333 + 333333333337F33333333333333B333333333333333733333333 + } + ModalResult = 3 + NumGlyphs = 2 + OnClick = BitBtn1Click + TabOrder = 2 + end + object SaveDialog1: TSaveDialog + Options = [ofOverwritePrompt, ofHideReadOnly] + left = 640 + top = 420 + end +end diff --git a/frmMain.pas b/frmMain.pas new file mode 100644 index 0000000..b2f018e --- /dev/null +++ b/frmMain.pas @@ -0,0 +1,330 @@ +unit frmMain; + +{$MODE Delphi} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, Spin, ComCtrls, Buttons; + +type + + { TMainForm } + + TMainForm = class(TForm) + DelayTime: TSpinEdit; + lblDelayTime: TLabel; + Label1: TLabel; + SaveDialog1: TSaveDialog; + PageControl1: TPageControl; + InformationSheet: TTabSheet; + DelphiFormSheet: TTabSheet; + Information: TButton; + WndValue: TEdit; + Label3: TLabel; + PasFileName: TEdit; + BrowsePas: TButton; + Label4: TLabel; + FormName: TEdit; + SavePas: TButton; + lblWndValue: TLabel; + optAutomatic: TRadioButton; + optManual: TRadioButton; + RCSheet: TTabSheet; + Label2: TLabel; + RCFileName: TEdit; + BrowseRC: TButton; + SaveRC: TButton; + BitBtn1: TBitBtn; + procedure InformationClick(Sender: TObject); + procedure BrowsePasClick(Sender: TObject); + procedure BrowseRCClick(Sender: TObject); + procedure SavePasClick(Sender: TObject); + procedure PasEditChange(Sender: TObject); + procedure optManualClick(Sender: TObject); + procedure optAutomaticClick(Sender: TObject); + procedure RCFileNameChange(Sender: TObject); + procedure BitBtn1Click(Sender: TObject); + procedure SaveRCClick(Sender: TObject); + private + procedure GenerateDfmFile(const filename, frmname: string; + wnd: HWND; PasList: TStrings); + procedure GeneratePasFile(const filename, frmname: string; PasList: TStrings); + procedure GetWinInfo(wnd: HWND; ParentNode: TTreeNode); + procedure EnableSavePas; + procedure EnableWndInput; + public + { Public declarations } + end; + +var + MainForm: TMainForm; + +implementation + +uses frmResults, Writers, DfmEngine, StrConsts, about1; + +{$R *.lfm} + +procedure TMainForm.GetWinInfo(wnd: HWND; ParentNode: TTreeNode); +var + len, i, cbcount: integer; + Text: PChar; + class_name: array [0..100] of char; + R1, R2: TRect; + node1, node2: TTreeNode; + childlist: TList; + EnumParams: TEnumParams; + style, exstyle: integer; + parentWnd: HWND; + itemtext: array [0..300] of char; +begin + if not IsWindow(wnd) then + begin + Results.TreeView1.Items.AddChild(ParentNode, 'Handle = (INVALID HANDLE)'); + Exit; + end; + childlist := TList.Create; + len := GetWindowTextLength(wnd) + 1; + GetMem(Text, len); + GetWindowText(wnd, Text, len); + GetWindowRect(wnd, R1); + Windows.GetClientRect(wnd, R2); + GetClassName(wnd, class_name, 100); + style := GetWindowLong(wnd, GWL_STYLE); + exstyle := GetWindowLong(wnd, GWL_EXSTYLE); + parentWnd := GetParent(wnd); + EnumParams.List := childlist; + EnumParams.ParentWnd := wnd; + EnumChildWindows(wnd, @EnumChildrenProc, integer(@EnumParams)); + + with Results.TreeView1.Items do + begin + AddChild(ParentNode, 'Handle = ' + IntToStr(wnd)); + AddChild(ParentNode, 'Caption = ' + Text); + AddChild(ParentNode, 'Class name = ' + class_name); + AddChild(ParentNode, 'Parent Handle = ' + IntToStr(parentWnd)); + node1 := AddChild(ParentNode, 'Style'); + AddChild(node1, 'Value = ' + IntToStr(style)); + for i := Low(WindowStyle) to High(WindowStyle) do + if ((style and WindowStyle[i]) = WindowStyle[i]) then + AddChild(node1, WindowStyleName[i]); + + node1 := AddChild(ParentNode, 'Extended Style'); + AddChild(node1, 'Value = ' + IntToStr(exstyle)); + for i := Low(WindowStyle) to High(WindowStyle) do + if ((style and ExtendedWindowStyle[i]) = ExtendedWindowStyle[i]) then + AddChild(node1, ExtendedWindowStyleName[i]); + node1 := AddChild(ParentNode, 'Placement'); + AddChild(node1, 'Left = ' + IntToStr(R1.Left)); + AddChild(node1, 'Top = ' + IntToStr(R1.Top)); + AddChild(node1, 'Width = ' + IntToStr(R1.Right - R1.Left)); + AddChild(node1, 'Height = ' + IntToStr(R1.Bottom - R1.Top)); + AddChild(node1, 'ClientWidth = ' + IntToStr(R2.Right)); + AddChild(node1, 'ClientHeight = ' + IntToStr(R2.Bottom)); + if (CompareText(class_name, 'COMBOBOX') = 0) then + begin + node1 := AddChild(ParentNode, '[List Data]'); + cbcount := SendMessage(wnd, CB_GETCOUNT, 0, 0); + for i := 1 to cbcount do + begin + SendMessage(wnd, CB_GETLBTEXT, i - 1, longint(@itemtext)); + node2 := AddChild(node1, 'Item #' + IntToStr(i)); + AddChild(node2, 'Text = ' + itemtext); + AddChild(node2, 'Data = ' + IntToStr(SendMessage(wnd, CB_GETITEMDATA, i - 1, 0))); + end; + end; + if childlist.Count > 0 then + begin + node1 := AddChild(ParentNode, 'Children information'); + for i := 1 to childlist.Count do + begin + node2 := AddChild(node1, 'Child #' + IntToStr(i)); + GetWinInfo(integer(childlist[i - 1]), node2); + end; + end; + end; + FreeMem(Text); + childlist.Free; +end; + +procedure TMainForm.InformationClick(Sender: TObject); +var + wnd: HWND; +begin + if optAutomatic.Checked then + begin + Application.Minimize; + Sleep(DelayTime.Value); + wnd := GetForegroundWindow; + Application.Restore; + end + else + wnd := StrToInt(WndValue.Text); + + Results.Show; + Results.TreeView1.Items.Clear; + GetWinInfo(wnd, nil); +end; + +procedure TMainForm.BrowsePasClick(Sender: TObject); +var + s: string; +begin + with SaveDialog1 do + begin + FileName := ''; + DefaultExt := 'pas'; + Filter := 'Delphi Units|*.pas'; + if Execute then + begin + PasFileName.Text := FileName; + s := ChangeFileExt(ExtractFileName(FileName), ''); + if LowerCase(Copy(s, 1, 3)) = 'frm' then + s := Copy(s, 4, Length(s) - 3) + 'Form' + else + s := s + 'Form'; + FormName.Text := s; + end; + end; +end; + +procedure TMainForm.BrowseRCClick(Sender: TObject); +begin + with SaveDialog1 do + begin + FileName := ''; + DefaultExt := 'rc'; + Filter := 'Resource scripts|*.rc'; + // if Execute then RCFileName.Text := FileName; + end; +end; + + +procedure TMainForm.GenerateDfmFile(const filename, frmName: string; + wnd: HWND; PasList: TStrings); +var + OutStream: TFileStream; + b1: TDfmBuilder; +begin + b1 := TDfmBuilder.Create(PasList); + OutStream := TFileStream.Create(filename, fmCreate); + b1.Build(OutStream, frmName, wnd); + OutStream.Free; + b1.Free; +end; + +procedure TMainForm.GeneratePasFile(const filename, frmname: string; PasList: TStrings); +var + title: string; + fpas: TTextWriter; + i: integer; +begin + fpas := TTextWriter.CreateFile(filename); + try + title := ChangeFileExt(ExtractFileName(filename), ''); + with fpas do + begin + WriteLn('unit ' + title + ';'); + WriteLn(''); + WriteLn('interface'); + WriteLn(''); + WriteLn('uses'); + WriteLn(' Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,'); + WriteLn(' StdCtrls;'); + WriteLn(''); + WriteLn('type'); + WriteLn(' T' + frmname + ' = class(TForm)'); + for i := 0 to PasList.Count - 1 do + WriteLn(' ' + PasList[i]); + WriteLn(' private'); + WriteLn(' { Private declarations }'); + WriteLn(' public'); + WriteLn(' { Public declarations }'); + WriteLn(' end;'); + WriteLn(''); + WriteLn('var'); + WriteLn(' ' + frmname + ': T' + frmname + ';'); + WriteLn(''); + WriteLn('implementation'); + WriteLn(''); + WriteLn('{$R *.DFM}'); + WriteLn(''); + WriteLn('end.'); + end; + finally + fpas.Free; + end; +end; + +procedure TMainForm.SavePasClick(Sender: TObject); +var + dfmName: string; + wnd: HWND; + s: TStringList; +begin + Application.Minimize; + Sleep(DelayTime.Value); + + wnd := GetForegroundWindow; + Application.Restore; + + dfmName := ChangeFileExt(PasFileName.Text, '.dfm'); + s := TStringList.Create; + GenerateDfmFile(dfmName, FormName.Text, wnd, s); + GeneratePasFile(PasFileName.Text, FormName.Text, s); + s.Free; +end; + + +procedure TMainForm.EnableSavePas; +var + UnitName: string; +begin + UnitName := ChangeFileExt(ExtractFileName(PasFileName.Text), ''); + SavePas.Enabled := IsValidIdent(FormName.Text) and IsValidIdent(UnitName) and + (CompareText(UnitName, FormName.Text) <> 0); +end; + +procedure TMainForm.PasEditChange(Sender: TObject); +begin + EnableSavePas; +end; + + + + +procedure TMainForm.EnableWndInput; +begin + WndValue.Enabled := optManual.Checked; + lblWndValue.Enabled := optManual.Checked; +end; + +procedure TMainForm.optManualClick(Sender: TObject); +begin + EnableWndInput; +end; + +procedure TMainForm.optAutomaticClick(Sender: TObject); +begin + EnableWndInput; +end; + + +procedure TMainForm.RCFileNameChange(Sender: TObject); +begin + SaveRC.Enabled := False; +end; + +procedure TMainForm.BitBtn1Click(Sender: TObject); +begin + AboutBox.ShowModal; +end; + +procedure TMainForm.SaveRCClick(Sender: TObject); +begin + +end; + +end. diff --git a/frmResults.lfm b/frmResults.lfm new file mode 100644 index 0000000..da44207 --- /dev/null +++ b/frmResults.lfm @@ -0,0 +1,32 @@ +object Results: TResults + Left = 197 + Height = 395 + Top = 144 + Width = 390 + Caption = 'Chameleon Information' + ClientHeight = 395 + ClientWidth = 390 + Color = clBtnFace + DesignTimePPI = 168 + Font.Color = clWindowText + Font.Height = -24 + Font.Name = 'Tahoma' + LCLVersion = '1.8.0.6' + object TreeView1: TTreeView + Left = 0 + Height = 395 + Top = 0 + Width = 390 + Align = alClient + Indent = 19 + TabOrder = 0 + end + object popListData: TPopupMenu + left = 101 + top = 15 + object Savelistdata1: TMenuItem + Caption = 'Save list data...' + OnClick = Savelistdata1Click + end + end +end diff --git a/frmResults.pas b/frmResults.pas new file mode 100644 index 0000000..7cd5fe7 --- /dev/null +++ b/frmResults.pas @@ -0,0 +1,66 @@ +unit frmResults; + +{$MODE Delphi} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, Menus; + +type + TResults = class(TForm) + popListData: TPopupMenu; + Savelistdata1: TMenuItem; + TreeView1: TTreeView; + procedure TreeView1Change(Sender: TObject; Node: TTreeNode); + procedure Savelistdata1Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Results: TResults; + +implementation + +{$R *.lfm} + + +procedure TResults.TreeView1Change(Sender: TObject; Node: TTreeNode); +begin + if (Assigned(Node) and (Node.Text = '[List Data]')) then + TreeView1.PopupMenu := popListData + else + TreeView1.PopupMenu := nil; +end; + +procedure TResults.Savelistdata1Click(Sender: TObject); +var + f: TextFile; + n: TTreeNode; + i: integer; + + function RemoveTag(const s: string): string; + var + pos1: integer; + begin + pos1 := Pos('=', s); + Result := Copy(s, pos1 + 2, Length(s) - pos1 - 1); + end; + +begin + AssignFile(f, 'c:\listdata.csv'); + Rewrite(f); + n := TreeView1.Selected; + for i := 0 to n.Count - 1 do + begin + WriteLn(f, i, ';', RemoveTag(n.Items[i].Items[0].Text), ';', + RemoveTag(n.Items[i].Items[1].Text)); + end; + CloseFile(f); +end; + +end.