From a5cf23eda40dd2c5d924ae5f48aaa9bca9e8c123 Mon Sep 17 00:00:00 2001 From: Nikolaos Georgiou Date: Sat, 29 May 2021 07:57:12 +0200 Subject: [PATCH] Add 'pas/' from commit '71642f0773f3b21b1e6bcdfcfdbdb186b6c8f78c' git-subtree-dir: pas git-subtree-mainline: 6d5784cc4089eeb4864244cd4951b1aa66b4e90e git-subtree-split: 71642f0773f3b21b1e6bcdfcfdbdb186b6c8f78c --- Chameleon.dof | 87 ++++++++++ Chameleon.lpi | 116 +++++++++++++ Chameleon.lpr | 24 +++ Chameleon.res | Bin 0 -> 1656 bytes DfmEngine.pas | 444 +++++++++++++++++++++++++++++++++++++++++++++++++ README.md | 2 + StrConsts.pas | 106 ++++++++++++ Writers.pas | 190 +++++++++++++++++++++ about1.lfm | 94 +++++++++++ about1.pas | 32 ++++ frmMain.lfm | 228 +++++++++++++++++++++++++ frmMain.pas | 330 ++++++++++++++++++++++++++++++++++++ frmResults.lfm | 32 ++++ frmResults.pas | 66 ++++++++ 14 files changed, 1751 insertions(+) create mode 100644 Chameleon.dof create mode 100644 Chameleon.lpi create mode 100644 Chameleon.lpr create mode 100644 Chameleon.res create mode 100644 DfmEngine.pas create mode 100644 README.md create mode 100644 StrConsts.pas create mode 100644 Writers.pas create mode 100644 about1.lfm create mode 100644 about1.pas create mode 100644 frmMain.lfm create mode 100644 frmMain.pas create mode 100644 frmResults.lfm create mode 100644 frmResults.pas 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 0000000000000000000000000000000000000000..d5ab174bd1622a4cfd0fd735d9a16cdaedb470cd GIT binary patch literal 1656 zcma)6O^@3)5ZzvSC{Q5B9vL1BP~Vc}g}i|gw1APM39#D~JyPUoSExj)B;}0}<hQ4z z4|}!2u2TcDL=O2l@6F>}TwGibe7=629{hat%YQt^f5A0BjIkFl9+niZKD7<mgR!+% z8yb26C7^_swYuHVKW~0#IVIL{C3&M2Z0G?jeRcKoPX)IY+Ojzi1W<NEd!sI`xPz8k z*4Dykt1HKZZZElQy?sbY%T-;0bsv|fArv`b?Ib8yyThY|ykJPGGg^SP+H8%us~rf} z8%*a{N)&JL<F#%(t`2|T!24jd?1dY@w_P{9DRGAmm)+MYj;KGLD!~d<cMh3f{jGaL zc-J+x;KKx21iivvjOMK!C`?uyh9M~=Ok=m5RT-zBAhyh6&ivg`Ebp&cNquiU<kD)z zUTfuyZY+I}BOAmxFGtsxNa76~ZuCEZCC$=xT4qU@Btlf7tSD)?y6ySxsNSdq83;Z> z;9+{=Svb>Mw^Nn=pGA-9B##Br8?5WBih+N7^a02Zrry^L+=87Vq&S6s`-FRjO1y<V zG^82+H<a6*+9NMRNndZp;D`;acw=FzDVD-NL41Q=_{%g3|3qduyFjCMSoyMU2LFB6 z(~p)9?w*J)95i!%$rzdIN<P+jlL%vT$o5^Q4a)HTn(X9;eugLr!z5j?FikR+#3E%p zt$+nVE&(8xaTR=_WU3h{me8v+uyGp3dAa5+m1~5pO38AFB;!$%1W}Y$>zF?So1cMA zcvM9>#4L@=HA|8tWF=n<CbP9nc)~M?^XFi_@C<NRWvfiAGL{DrvLuSv3@u!;JeEO~ z$w2bebHHJ61~-SGTJbPqWmU$g1LO=<Nm-ItG7Wf`^7T>&|Jz~~{-dgow!z-Ek1rQ1 zC+iG7Zy$fRDIV{~go3?kxc=AR9ClxOG~u0d-KFo(z12JQRu8lBuix$bC<s!2_SkXr o<VS2wUA?{M2Ci;Q4|t!C!?A1mPo6vSnnMd>I9=fE)by|Z1N&42q5uE@ literal 0 HcmV?d00001 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.