/trunk/Delphi Code/ParamUtils/DemoMain.ddp |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/trunk/Delphi Code/ParamUtils/Demo.cfg |
---|
0,0 → 1,35 |
-$A8 |
-$B- |
-$C+ |
-$D+ |
-$E- |
-$F- |
-$G+ |
-$H+ |
-$I+ |
-$J- |
-$K- |
-$L+ |
-$M- |
-$N+ |
-$O+ |
-$P+ |
-$Q- |
-$R- |
-$S- |
-$T- |
-$U- |
-$V+ |
-$W- |
-$X+ |
-$YD |
-$Z1 |
-cg |
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
-H+ |
-W+ |
-M |
-$M16384,1048576 |
-K$00400000 |
-LE"c:\programme\borland\delphi6\Projects\Bpl" |
-LN"c:\programme\borland\delphi6\Projects\Bpl" |
/trunk/Delphi Code/ParamUtils/ParamUtils.pas |
---|
0,0 → 1,92 |
unit ParamUtils; |
// ParamUtils.pas |
// Copyright (C) 2010 ViaThinkSoft. All rights reserved. |
interface |
uses |
Windows, SysUtils, Classes, Functions; |
type |
TParamInfo = packed record |
ParamName: String; // in actual case, if found |
Found: boolean; |
Position: integer; // only if found, otherwise 0 |
Values: TDynStringArray; |
end; |
function CheckParam(AParamStr: String; ACaseSensitive: boolean): TParamInfo; |
// function DecodeFilename(): TDynStringArray; |
// function GetFilenames(AOffset: integer): TDynStringArray; |
// function GetFilenames(): TDynStringArray; |
implementation |
function _NewParamInfo: TParamInfo; |
begin |
result.ParamName := ''; |
result.Found := false; |
result.Position := 0; |
SetLength(result.Values, 0); |
end; |
function _IsFlag(AParam: string): boolean; |
var |
c: string; |
begin |
c := Copy(AParam, 1, 1); |
result := (c = '/') or (c = '-'); |
end; |
function CheckParam(AParamStr: String; ACaseSensitive: boolean): TParamInfo; |
var |
i: integer; |
s: String; |
begin |
result := _NewParamInfo; |
result.ParamName := AParamStr; |
// Search |
for i := 1 to ParamCount do |
begin |
s := ParamStr(i); |
if s = '--' then break; |
if ACaseSensitive then |
begin |
result.Found := AnsiUpperCase(AParamStr) = AnsiUpperCase(s); |
end |
else |
begin |
result.Found := AParamStr = s; |
end; |
if result.Found then |
begin |
result.Position := i; |
result.ParamName := s; // Correct case |
break; |
end; |
end; |
// Determinate value |
if result.Found then |
begin |
for i := result.Position+1 to ParamCount do |
begin |
s := ParamStr(i); |
if not _IsFlag(s) then |
begin |
AppendStringToArray(result.Values, s); |
end; |
end; |
end; |
end; |
end. |
/trunk/Delphi Code/ParamUtils/Demo.exe |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/trunk/Delphi Code/ParamUtils/Demo.dpr |
---|
0,0 → 1,15 |
program Demo; |
uses |
Forms, |
DemoMain in 'DemoMain.pas' {Form1}, |
ParamUtils in 'ParamUtils.pas', |
Functions in 'Functions.pas'; |
{$R *.res} |
begin |
Application.Initialize; |
Application.CreateForm(TForm1, Form1); |
Application.Run; |
end. |
/trunk/Delphi Code/ParamUtils/Functions.pas |
---|
0,0 → 1,66 |
unit Functions; |
interface |
uses |
Windows, SysUtils; |
type |
TDynStringArray = array of String; |
procedure AppendStringToArray(var x: TDynStringArray; const s: string); |
function ExtendFilename(s: string; AllowDirs: boolean): TDynStringArray; |
implementation |
procedure AppendStringToArray(var x: TDynStringArray; const s: string); |
begin |
SetLength(x, Length(x)+1); |
x[Length(x)-1] := s; |
end; |
// Src: http://www.swissdelphicenter.ch/torry/showcode.php?id=1140 |
function _ExpandEnvironment(const strValue: string): string; |
var |
chrResult: array[0..1023] of Char; |
wrdReturn: DWORD; |
begin |
wrdReturn := ExpandEnvironmentStrings(PChar(strValue), chrResult, 1024); |
if wrdReturn = 0 then |
Result := strValue |
else |
begin |
Result := Trim(chrResult); |
end; |
end; |
function ExtendFilename(s: string; AllowDirs: boolean): TDynStringArray; |
var |
SR: TSearchRec; |
IsFound: boolean; |
begin |
// 1. Expand environment variables |
s := _ExpandEnvironment(s); |
// 2. Expand wildcards (and ensure that file/directory actually exists!) |
if AllowDirs then |
IsFound := FindFirst(s, faAnyFile, SR) = 0 |
else |
IsFound := FindFirst(s, faAnyFile-faDirectory, SR) = 0; |
try |
while IsFound do |
begin |
// 3. Make UNC |
s := ExpandUNCFileName(SR.Name); |
AppendStringToArray(result, s); |
IsFound := FindNext(SR) = 0; |
end; |
finally |
FindClose(SR); |
end; |
end; |
end. |
/trunk/Delphi Code/ParamUtils/Demo.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=0 |
AutoIncBuild=0 |
MajorVer=1 |
MinorVer=0 |
Release=0 |
Build=0 |
Debug=0 |
PreRelease=0 |
Special=0 |
Private=0 |
DLL=0 |
Locale=1031 |
CodePage=1252 |
[Version Info Keys] |
CompanyName= |
FileDescription= |
FileVersion=1.0.0.0 |
InternalName= |
LegalCopyright= |
LegalTrademarks= |
OriginalFilename= |
ProductName= |
ProductVersion=1.0.0.0 |
Comments= |
/trunk/Delphi Code/ParamUtils/DemoMain.pas |
---|
0,0 → 1,25 |
unit DemoMain; |
interface |
uses |
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
Dialogs, StdCtrls; |
type |
TForm1 = class(TForm) |
Button1: TButton; |
private |
{ Private-Deklarationen } |
public |
{ Public-Deklarationen } |
end; |
var |
Form1: TForm1; |
implementation |
{$R *.dfm} |
end. |
/trunk/Delphi Code/ParamUtils/Demo.res |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/trunk/Delphi Code/ParamUtils/DemoMain.dfm |
---|
0,0 → 1,24 |
object Form1: TForm1 |
Left = 192 |
Top = 131 |
Width = 870 |
Height = 640 |
Caption = 'Form1' |
Color = clBtnFace |
Font.Charset = DEFAULT_CHARSET |
Font.Color = clWindowText |
Font.Height = -13 |
Font.Name = 'MS Sans Serif' |
Font.Style = [] |
OldCreateOrder = False |
PixelsPerInch = 120 |
TextHeight = 16 |
object Button1: TButton |
Left = 120 |
Top = 136 |
Width = 409 |
Height = 241 |
Caption = 'Button1' |
TabOrder = 0 |
end |
end |
/trunk/Delphi Code/DragNDropDlgs/DlgExtended.res |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/trunk/Delphi Code/DragNDropDlgs/WindowsCompat.pas |
---|
0,0 → 1,78 |
unit WindowsCompat; |
// Ref: http://qc.embarcadero.com/wc/qcmain.aspx?d=48771 |
interface |
uses |
Windows; |
{$IF NOT DECLARED(GWLP_WNDPROC)} |
const |
GWLP_WNDPROC = -4; |
{$IFEND} |
{$IF NOT DECLARED(PtrInt)} |
type |
{$IFDEF WIN32} |
PtrInt = Longint; |
{$ELSE} |
PtrInt = Int64; |
{$ENDIF} |
{$IFEND} |
{$IF NOT DECLARED(LONG_PTR)} |
type |
LONG_PTR = PtrInt; // Offizielle Deklaration? |
{$IFEND} |
{$IF NOT DECLARED(WNDPROC)} |
type |
WNDPROC = TFNWndProc; // Offizielle Deklaration? |
{$IFeND} |
{$IF NOT DECLARED(GetWindowLongPtr)} |
{$DEFINE Do_Implement_GetWindowLongPtr} |
function GetWindowLongPtr(hWnd: HWND; nIndex: Integer): LONG_PTR; stdcall; |
{$IFEND} |
{$IF NOT DECLARED(SetWindowLongPtr)} |
{$DEFINE Do_Implement_SetWindowLongPtr} |
function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: LONG_PTR): LONG_PTR; stdcall; |
{$IFEND} |
implementation |
{$IFDEF Do_Implement_GetWindowLongPtr} |
{$IFNDEF _WIN64} |
{$IFDEF UNICODE} |
function GetWindowLongPtr; external user32 name 'GetWindowLongW'; |
{$ELSE} |
function GetWindowLongPtr; external user32 name 'GetWindowLongA'; |
{$ENDIF} |
{$ELSE} |
{$IFDEF UNICODE} |
function GetWindowLongPtr; external user32 name 'GetWindowLongPtrW'; |
{$ELSE} |
function GetWindowLongPtr; external user32 name 'GetWindowLongPtrA'; |
{$ENDIF} |
{$ENDIF} |
{$ENDIF} |
{$IFDEF Do_Implement_SetWindowLongPtr} |
{$IFNDEF _WIN64} |
{$IFDEF UNICODE} |
function SetWindowLongPtr; external user32 name 'SetWindowLongW'; |
{$ELSE} |
function SetWindowLongPtr; external user32 name 'SetWindowLongA'; |
{$ENDIF} |
{$ELSE} |
{$IFDEF UNICODE} |
function SetWindowLongPtr; external user32 name 'SetWindowLongPtrW'; |
{$ELSE} |
function SetWindowLongPtr; external user32 name 'SetWindowLongPtrA'; |
{$ENDIF} |
{$ENDIF} |
{$ENDIF} |
end. |
/trunk/Delphi Code/DragNDropDlgs/DlgExtended.cfg |
---|
0,0 → 1,35 |
-$A8 |
-$B- |
-$C+ |
-$D+ |
-$E- |
-$F- |
-$G+ |
-$H+ |
-$I+ |
-$J- |
-$K- |
-$L+ |
-$M- |
-$N+ |
-$O+ |
-$P+ |
-$Q- |
-$R- |
-$S- |
-$T- |
-$U- |
-$V+ |
-$W- |
-$X+ |
-$YD |
-$Z1 |
-cg |
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
-H+ |
-W+ |
-M |
-$M16384,1048576 |
-K$00400000 |
-LE"c:\programme\borland\delphi6\Projects\Bpl" |
-LN"c:\programme\borland\delphi6\Projects\Bpl" |
/trunk/Delphi Code/DragNDropDlgs/Main.pas |
---|
0,0 → 1,41 |
unit Main; |
interface |
uses |
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
Dialogs, StdCtrls; |
type |
TForm1 = class(TForm) |
Button1: TButton; |
procedure Button1Click(Sender: TObject); |
private |
{ Private-Deklarationen } |
public |
{ Public-Deklarationen } |
end; |
var |
Form1: TForm1; |
implementation |
uses |
DragDropOpenDlg; |
{$R *.dfm} |
procedure TForm1.Button1Click(Sender: TObject); |
var |
x: TDragDropOpenDlg; |
begin |
x := TDragDropOpenDlg.Create(self); |
try |
if x.execute then ShowMessage('Datei erhalten: ' + x.FileName); |
finally |
x.free; |
end; |
end; |
end. |
/trunk/Delphi Code/DragNDropDlgs/DlgExtended.exe |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/trunk/Delphi Code/DragNDropDlgs/MethodPtr.pas |
---|
0,0 → 1,45 |
unit MethodPtr; |
// Ref: http://www.swissdelphicenter.ch/de/showcode.php?id=1671 |
interface |
function MakeProcInstance(M: TMethod): Pointer; |
procedure FreeProcInstance(ProcInstance: Pointer); |
implementation |
// type TMyMethod = procedure of object; |
function MakeProcInstance(M: TMethod): Pointer; |
begin |
// allocate memory |
GetMem(Result, 15); |
asm |
// MOV ECX, |
MOV BYTE PTR [EAX], $B9 |
MOV ECX, M.Data |
MOV DWORD PTR [EAX+$1], ECX |
// POP EDX |
MOV BYTE PTR [EAX+$5], $5A |
// PUSH ECX |
MOV BYTE PTR [EAX+$6], $51 |
// PUSH EDX |
MOV BYTE PTR [EAX+$7], $52 |
// MOV ECX, |
MOV BYTE PTR [EAX+$8], $B9 |
MOV ECX, M.Code |
MOV DWORD PTR [EAX+$9], ECX |
// JMP ECX |
MOV BYTE PTR [EAX+$D], $FF |
MOV BYTE PTR [EAX+$E], $E1 |
end; |
end; |
procedure FreeProcInstance(ProcInstance: Pointer); |
begin |
// free memory |
FreeMem(ProcInstance, 15); |
end; |
end. |
/trunk/Delphi Code/DragNDropDlgs/Main.dfm |
---|
0,0 → 1,25 |
object Form1: TForm1 |
Left = 192 |
Top = 131 |
Width = 870 |
Height = 640 |
Caption = 'Form1' |
Color = clBtnFace |
Font.Charset = DEFAULT_CHARSET |
Font.Color = clWindowText |
Font.Height = -13 |
Font.Name = 'MS Sans Serif' |
Font.Style = [] |
OldCreateOrder = False |
PixelsPerInch = 120 |
TextHeight = 16 |
object Button1: TButton |
Left = 136 |
Top = 136 |
Width = 161 |
Height = 81 |
Caption = 'Button1' |
TabOrder = 0 |
OnClick = Button1Click |
end |
end |
/trunk/Delphi Code/DragNDropDlgs/DlgExtended.dpr |
---|
0,0 → 1,14 |
program DlgExtended; |
uses |
Forms, |
Main in 'Main.pas' {Form1}, |
DragDropOpenDlg in 'DragDropOpenDlg.pas'; |
{$R *.res} |
begin |
Application.Initialize; |
Application.CreateForm(TForm1, Form1); |
Application.Run; |
end. |
/trunk/Delphi Code/DragNDropDlgs/DragDropOpenDlg.pas |
---|
0,0 → 1,144 |
unit DragDropOpenDlg; |
// Improvements to the Dialogs |
// - New design |
// - Overwrite (Save) / MustExists (Open) as default |
// - DragDrop feature! |
// TODO (incl. QuerySystemMenu): Besser mit WndProc(var Message) und Dispatch wie in Dialogs.pas arbeiten? |
interface |
uses |
Windows, Dialogs, Classes, messages, shellapi, sysutils, WindowsCompat; |
type |
TDragDropOpenDlg = class(TOpenDialog) |
private |
MsgProcPointer: pointer; |
FPrevWndProc: LONG_PTR; |
procedure OpenDialog1Show(Sender: TObject); |
procedure OpenDialog1Close(Sender: TObject); |
function msgr(Handle: HWnd; Msg: UInt; |
WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; |
public |
constructor Create(AOwner: TComponent); override; |
end; |
implementation |
uses |
MethodPtr; |
{ TDragDropOpenDlg } |
const |
IDA = 101; |
function TDragDropOpenDlg.msgr(Handle: HWnd; Msg: UInt; |
WParam: Windows.WParam; LParam: Windows.LParam): LResult; |
const |
MAXFILENAME = 255; // TODO MAX_PATH? |
var |
cnt, fileCount : integer; |
fileName : array [0..MAXFILENAME] of char; |
begin |
if Msg = WM_DROPFILES then |
begin |
// how many files dropped? |
fileCount := DragQueryFile(wParam, $FFFFFFFF, fileName, MAXFILENAME) ; |
// query for file names |
for cnt := 0 to fileCount-1 do |
begin |
DragQueryFile(wParam, cnt, fileName, MAXFILENAME) ; |
//do something with the file(s) |
showmessage('Drag accepted: ' + filename); |
end; |
//release memory |
DragFinish(wParam); |
// TODO: Geht nicht |
SendMessage(Self.Handle, WM_CLOSE, 0, 0); |
DestroyWindow(Self.Handle); |
end; |
result := Windows.CallWindowProc({!!!}WindowsCompat.WNDPROC(FPrevWndProc), Handle, Msg, WParam, LParam) |
end; |
procedure TDragDropOpenDlg.OpenDialog1Show(Sender: TObject); |
var |
hParent: THandle; |
rect: TRect; |
hEdit: THandle; |
f: TMethod; |
begin |
// OpenDialog1.Handle ist irgendwie das falsche :? |
hParent := GetParent(Handle); |
// Position und Größe ermitteln |
GetWindowRect(hParent, rect); |
// Dialog vergrößern für Edit |
SetWindowPos(hParent, 0, 0, 0, rect.Right - rect.Left, rect.Bottom - rect.Top |
+ 25*2, SWP_NOMOVE); |
// Edit erzeugen, ID = 101 |
hEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', '', WS_VISIBLE or WS_CHILD, |
195, rect.Bottom - rect.Top - 27, 150, 20, hParent, IDA, 0, nil); |
if hEdit = 0 then |
RaiseLastOSError; |
FPrevWndProc := GetWindowLongPtr(hEdit, GWLP_WNDPROC); |
f.Code := @TDragDropOpenDlg.msgr; |
f.Data := Self; |
MsgProcPointer := {!!!}MethodPtr.MakeProcInstance(f); |
// Problem: Kann es zu Komplikationen mit mehreren msg handlern kommen? |
// (Beim vermischten register+unregister !) |
SetWindowLongPtr(hEdit, GWLP_WNDPROC, LONG_PTR(MsgProcPointer)); |
DragAcceptFiles(hEdit, true); |
end; |
procedure TDragDropOpenDlg.OpenDialog1Close(Sender: TObject); |
var |
hParent: THandle; |
hEdit: THandle; |
Buffer: PChar; |
len: Integer; |
begin |
hParent := GetParent(Handle); |
// Handle des Edits ermitteln, ID = 101 siehe oben |
hEdit := GetDlgItem(hParent, IDA); |
DragAcceptFiles(hEdit, false); |
SetWindowLongPtr(hEdit, GWLP_WNDPROC, FPrevWndProc); |
// Speicher allozieren |
len := SendMessage(hEdit, WM_GETTEXTLENGTH, 0, 0); |
GetMem(Buffer, len + 1); |
try |
ZeroMemory(Buffer, len + 1); |
// Text aus Edit holen |
SendMessage(hEdit, WM_GETTEXT, len, lParam(Buffer)); |
ShowMessage('Text im Editfeld:' + Buffer); |
finally |
FreeMem(Buffer, len + 1); |
end; |
end; |
constructor TDragDropOpenDlg.Create(AOwner: TComponent); |
begin |
inherited; |
// TODO: Als Wrapper, damit auch weiter verwendbar! |
OnClose := OpenDialog1Close; |
OnShow := OpenDialog1Show; |
end; |
// {!!!} = Bitte auch in QuerySystemMenu verwenden! |
end. |
/trunk/Delphi Code/DragNDropDlgs/DlgExtended.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=0 |
AutoIncBuild=0 |
MajorVer=1 |
MinorVer=0 |
Release=0 |
Build=0 |
Debug=0 |
PreRelease=0 |
Special=0 |
Private=0 |
DLL=0 |
Locale=1031 |
CodePage=1252 |
[Version Info Keys] |
CompanyName= |
FileDescription= |
FileVersion=1.0.0.0 |
InternalName= |
LegalCopyright= |
LegalTrademarks= |
OriginalFilename= |
ProductName= |
ProductVersion=1.0.0.0 |
Comments= |