smb2_poc.dpr:
program smb2_poc;

Occupancy Plan ist ein einfaches Plugin für WordPress, das eine Übersicht von z.B. belegten Ferienwohnungen oder Ferienhäuser kalendarisch anzeigt.

Viele graphische Einstellungen für Farbe und Formen, sowie das Eintragen der belegten Tage im Kalender können ganz leicht und Benutzerfreundlich vom Admin vorgenommen werden. Des weiteren können – unabhängig von einander – mehrere Übersichten im Blog dargestellt werden. Somit lassen sich Belegungspläne, beispielsweise auch für mehrere Objekte wie bei Pensionen üblich, einpflegen.

Hier geht es zum WP Plugin Download

Geplante Verbesserungen im Plugin (Visionen)

• Es gibt noch einige kleinere Probleme mit einigen Themes, die ich aber die nächste Zeit beheben werde.
• Export der Daten in .csv oder .xls Format zum Einbinden anderer Buchungssysteme
• Importfunktionalität zum automatisiertem Datenempfang und Abgleich als Anschluss an ein anderes Buchungssystem
• Vollautomatische Synchronisation mit diversen Belegungs- und Buchungssystemen
• Belegungsplanausgabe als PDF
• Druckfunktion (definierbare Zeiträume)
• Hinterlegung mit Namen bei Belegungszeiträumen
• Einarbeitung einer Rechtestruktur
• Unterscheidung zwischen vorbehaltlich Reserviert und verbindlich Gebucht

Diese geplanten Erweiterungen und Verbesserungen wollen wir zukünftig gerne einarbeiten. Welche Funktionalitäten aber genau eingearbeitet werden und wann dies sein wird hängt unter anderem auch von der Nachfrage nach dem Plugin ab. Habt Ihr Anregungen oder Verbesserungsvorschläge? Schreibt uns gerne Eure Ideen und Wünsche.

Fragen, Anregungen und Kritik könnt Ihr uns gerne hier mitteilen.

Beispielhafte Darstellung des 1. Belegungsplans

Da die erste Version des Plugins auf diese Seite zeigt, steht sie hier noch immer drinne. Wenn ich Kommentare zu diesem Plugin abgeben wollt, dann könnt ihr das gerne auf dieser Seite machen.

Für unser erstes unter GPL3 Licens gestelltes Plugin »occupancyplan«für das Blogsystem und CMS WordPress wollen wir natürlich so viele Anregungen wie nur irgend möglich bekommen. Deshalb geben wir Euch hier die Möglichkeiten, uns mit Lob und Kritik zu versorgen. Natürlich freuen wir uns auch über jede neue Spende.

Hier geht es zum WP Plugin Download!

Eine kleine Übersicht meiner bisherigen Delphi sourcen. Die alte Übersichtsseite ist noch online und steht hier:

delphi source

Gefallen Euch meine sourcen – freue ich mich über Eure Spende – Danke!

X000X-ActiveX.pas

Ich habe hier mal ein paar ältere Delphi sourcen eingearbeitet. Die Originale findet Ihr immer noch hier:

X000X-Btn.pas
X000X-SysUtils.pas
X000X-ActiveX.pas

unit X000XActiveX;

interface

uses Windows;

type
  OLE_HANDLE = LongWord;
  OLE_XPOS_HIMETRIC  = Longint;
  OLE_YPOS_HIMETRIC  = Longint;
  OLE_XSIZE_HIMETRIC = Longint;
  OLE_YSIZE_HIMETRIC = Longint;
  Largeint = Int64;
  POleStr = PWideChar;
  TIID = TGUID;
  TCLSID = TGUID;

  IStream = interface;

{ IStream interface }

  PStatStg = ^TStatStg;
  tagSTATSTG = record
    pwcsName: POleStr;
    dwType: Longint;
    cbSize: Largeint;
    mtime: TFileTime;
    ctime: TFileTime;
    atime: TFileTime;
    grfMode: Longint;
    grfLocksSupported: Longint;
    clsid: TCLSID;
    grfStateBits: Longint;
    reserved: Longint;
  end;
  TStatStg = tagSTATSTG;
  STATSTG = TStatStg;

  ISequentialStream = interface(IUnknown)
    ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
    function Read(pv: Pointer; cb: Longint; pcbRead: PLongint): HResult;
      stdcall;
    function Write(pv: Pointer; cb: Longint; pcbWritten: PLongint): HResult;
      stdcall;
  end;

  IStream = interface(ISequentialStream)
    ['{0000000C-0000-0000-C000-000000000046}']
    function Seek(dlibMove: Largeint; dwOrigin: Longint;
      out libNewPosition: Largeint): HResult; stdcall;
    function SetSize(libNewSize: Largeint): HResult; stdcall;
    function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
      out cbWritten: Largeint): HResult; stdcall;
    function Commit(grfCommitFlags: Longint): HResult; stdcall;
    function Revert: HResult; stdcall;
    function LockRegion(libOffset: Largeint; cb: Largeint;
      dwLockType: Longint): HResult; stdcall;
    function UnlockRegion(libOffset: Largeint; cb: Largeint;
      dwLockType: Longint): HResult; stdcall;
    function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult;
      stdcall;
    function Clone(out stm: IStream): HResult; stdcall;
  end;

type
  IPicture = interface
    ['{7BF80980-BF32-101A-8BBB-00AA00300CAB}']
    function get_Handle(out handle: OLE_HANDLE): HResult;  stdcall;
    function get_hPal(out handle: OLE_HANDLE): HResult; stdcall;
    function get_Type(out typ: Smallint): HResult; stdcall;
    function get_Width(out width: OLE_XSIZE_HIMETRIC): HResult; stdcall;
    function get_Height(out height: OLE_YSIZE_HIMETRIC): HResult; stdcall;
    function Render(dc: HDC; x, y, cx, cy: Longint;
      xSrc: OLE_XPOS_HIMETRIC; ySrc: OLE_YPOS_HIMETRIC;
      cxSrc: OLE_XSIZE_HIMETRIC; cySrc: OLE_YSIZE_HIMETRIC;
      const rcWBounds: TRect): HResult; stdcall;
    function set_hPal(hpal: OLE_HANDLE): HResult; stdcall;
    function get_CurDC(out dcOut: HDC): HResult; stdcall;
    function SelectPicture(dcIn: HDC; out hdcOut: HDC;
      out bmpOut: OLE_HANDLE): HResult; stdcall;
    function get_KeepOriginalFormat(out fkeep: BOOL): HResult; stdcall;
    function put_KeepOriginalFormat(fkeep: BOOL): HResult; stdcall;
    function PictureChanged: HResult; stdcall;
    function SaveAsFile(const stream: IStream; fSaveMemCopy: BOOL;
      out cbSize: Longint): HResult; stdcall;
    function get_Attributes(out dwAttr: Longint): HResult; stdcall;
  end;

type
   TFNCreateStreamOnHGlobalX = function(hglob: HGlobal; fDeleteOnRelease: BOOL;
                                        out stm: IStream): HResult; stdcall;
   TFNOleLoadPictureX        = function(stream: IStream; lSize: Longint; fRunmode: BOOL;
                                        const iid: TIID; out vObject): HResult; stdcall;

{function CreateStreamOnHGlobal(hglob: HGlobal; fDeleteOnRelease: BOOL;
  out stm: IStream): HResult; stdcall;
function OleLoadPicture(stream: IStream; lSize: Longint; fRunmode: BOOL;
  const iid: TIID; out vObject): HResult; stdcall;}

var
   CreateStreamOnHGlobalX : TFNCreateStreamOnHGlobalX = nil;
   OleLoadPictureX        : TFNOleLoadPictureX = nil;

   function LoadPictureFromFile(AFile: String; var pPicture: IPicture) : Boolean;
   function LoadPictureFromRes(Instance: THandle; const szResName, szResType : String; var pPicture: IPicture) : Boolean;

implementation

const
   OLE32    = 'ole32.dll';
   OLEPRO32 = 'olepro32.dll';

var LibOle32,
    LibOlePro32 : HMODULE;

function LoadX000XActiveX: Boolean;
begin
   Result := False;
   LibOle32 := LoadLibrary(@OLE32[1]);
   if LibOle32 <> 0 then begin
      LibOlePro32 := LoadLibrary(@OLEPRO32[1]);
      if LibOlePro32 <> 0 then begin
         CreateStreamOnHGlobalX := GetProcAddress(LibOle32, PChar('CreateStreamOnHGlobal'));
         OleLoadPictureX        := GetProcAddress(LibOlePro32, PChar('OleLoadPicture'));
         if Assigned(CreateStreamOnHGlobalX) And
            Assigned(OleLoadPictureX) then begin
            Result := True;
            Exit;
         end else begin
            CreateStreamOnHGlobalX := nil;
            OleLoadPictureX := nil;
            FreeLibrary(LibOle32);
            FreeLibrary(LibOlePro32);
         end;
      end else
         FreeLibrary(LibOle32);
   end;
end;

procedure UnloadX000XActiveX;
begin
   CreateStreamOnHGlobalX := nil;
   OleLoadPictureX := nil;
   FreeLibrary(LibOle32);
   FreeLibrary(LibOlePro32);
end;

(* Funktion l�dt ein Bild von der HDD in eine Variable vom Typ IPicture (X000XActiveX.pas) *)
function LoadPictureFromFile(AFile: String; var pPicture: IPicture) : Boolean;
const IID_IPicture : TGUID = '{7BF80980-BF32-101A-8BBB-00AA00300CAB}';
var
   hFile, hMem : THandle;
   dwFileSize,
   dwBytesRead : DWord;
   pData       : Pointer;
   bRead       : Boolean;
   hRes        : HResult;
   pStream     : IStream;
Begin
   Result := False;
   if LoadX000XActiveX then begin
      hMem   := 0;
      (* Datei �ffnen *)
      hFile  := CreateFile(PChar(AFile), GENERIC_READ, 0, nil,  OPEN_EXISTING, 0, 0);
      if hFile = INVALID_HANDLE_VALUE then Exit;
      (* Sollte was schief laufen, steigen wir mit exit aus, aufger�umt wird im Finally Block *)
      try
         (* Dateigr��e holen *)
         dwFileSize := GetFileSize(hFile, nil);
         if dwFileSize = INVALID_FILE_SIZE then
            Exit;
         (* "Dateigr��e" an Bytes vom Heap anfordern *)
         hMem := GlobalAlloc(GHND or GMEM_NODISCARD, dwFileSize);
         if hMem = 0 then
            Exit;
         (* Einen Zeiger auf den soeben angeforderten Speicherblock holen *)
         pData := GlobalLock(hMem);
         if Not Assigned(pData) then
            Exit;
         (* Datei in den Speicher lesen *)
         (* Dateigr��e und gelesene Bytes sollten hiernach �bereinstimmen *)
         bRead := ReadFile(hFile, pData^ , dwFileSize, dwBytesRead, nil);
         GlobalUnlock(hMem);
         if not bRead then
            Exit;
         (* Ein StreamObject erstellen (wir geben den HeapSpeicher selber frei - 2. Parameter) *)
         pStream := nil;
         hRes := CreateStreamOnHGlobalX(hMem, False, pStream);
         if FAILED(hRes) or (pStream = nil) then
            Exit;
         (* Das Picture in die Variable pPicture (IPicture) laden und bei Erfolg True zur�ckgeben *)
         hRes := OleLoadPictureX(pStream, dwFileSize, False, IID_IPicture, pPicture);
         if (hRes = S_OK) and (pPicture <> nil) then
            Result := True;
         (* StreamObjekt zerst�ren *)
         pStream := nil;
      finally
         (* Wenn wir vorhin erfolgreich Speicher angefordert haben, ihn hier *)
         (* auf jedenfall wieder frei geben *)
         if hMem <> 0 then
            GlobalFree(hMem);
         (* und zu guterletzt die Datei wieder schlie�en *)
         CloseHandle(hFile);
         UnloadX000XActiveX;
      end;
   end;
End;

function LoadPictureFromRes(Instance: THandle; const szResName, szResType : String; var pPicture: IPicture) : Boolean;
const IID_IPicture : TGUID = '{7BF80980-BF32-101A-8BBB-00AA00300CAB}';
var
   hResInfo,
   hResGlobal,
   hMem : THandle;
   dwFileSize  : DWord;
   pData,
   pResData    : Pointer;
   hRes        : HResult;
   pStream     : IStream;
Begin
   Result := False;
   if LoadX000XActiveX then begin
      hMem   := 0;
      (* Resource suchen und wenn vorhanden... *)
      hResInfo := FindResource(Instance, Pointer(szResName), Pointer(szResType));
      if hResInfo = 0 then Exit;
      (* ... laden *)
      hResGlobal := LoadResource(Instance, hResInfo);
      if hResGlobal = 0 then Exit;
      (* Sollte was schief laufen, steigen wir mit exit aus, aufger�umt wird im Finally Block *)
      try
         (* Handle auf die Daten holen *)
         pResData := LockResource(hResGlobal);
         if Not Assigned(pResData) then Exit;
         (* Gr��e der Resource in Bytes holen *)
         dwFileSize := SizeofResource(Instance, hResInfo);
         if dwFileSize = 0 then Exit;
         (* "Dateigr��e" an Bytes vom Heap anfordern *)
         hMem := GlobalAlloc(GHND or GMEM_NODISCARD, dwFileSize);
         if hMem = 0 then
            Exit;
         (* Einen Zeiger auf den soeben angeforderten Speicherblock holen *)
         pData := GlobalLock(hMem);
         if Not Assigned(pData) then
            Exit;
         (* Daten in den Speicher lesen *)
         Move(pResData^, pData^, dwFileSize);
         GlobalUnlock(hMem);
         (* Ein StreamObject erstellen (wir geben den HeapSpeicher selber frei - 2. Parameter) *)
         pStream := nil;
         hRes := CreateStreamOnHGlobalX(hMem, False, pStream);
         if FAILED(hRes) or (pStream = nil) then
            Exit;
         (* Das Picture in die Variable pPicture (IPicture) laden und bei Erfolg True zur�ckgeben *)
         hRes := OleLoadPictureX(pStream, dwFileSize, False, IID_IPicture, pPicture);
         if (hRes = S_OK) and (pPicture <> nil) then
            Result := True;
         (* StreamObjekt zerst�ren *)
         pStream := nil;
      finally
         (* Wenn wir vorhin erfolgreich Speicher angefordert haben, ihn hier *)
         (* auf jedenfall wieder frei geben *)
         if hMem <> 0 then
            GlobalFree(hMem);
         (* und zu guterletzt die Resource freigeben *)
         if hResGlobal <> 0 then
            FreeResource(hResGlobal);
         UnloadX000XActiveX;
      end;
   end;
End;

end.

Gefallen Euch meine sourcen – freue ich mich über Eure Spende – Danke!

Ich habe hier mal ein paar ältere Delphi sourcen eingearbeitet. Die Originale findet Ihr immer noch hier:

X000XBtn.pas
X000XSysUtils.pas
X000XActiveX.pas

unit X000XSysUtils;

interface

Uses Windows;

   procedure ShowMessage(const szMessage: String);
   function FileExists(const szFileName: String): Boolean;
   procedure WriteDebug(const szStr: String; const Param : Boolean);
   function UpperCase(const s: String): String;
   function LowerCase(const s: String): String;
   function IntToStr(const i: Int64): string;
   function Format(fmt: string; params: array of const): string;
   procedure FreeAndNil(var Obj);

implementation

procedure ShowMessage(const szMessage: String);
begin
   MessageBox(0, Pointer(szMessage), 'InfoBox', 0);
end;

function FileExists(const szFileName: String): Boolean;
var
   Handle   : THandle;
   FindData : TWin32FindData;
begin
   Handle   := FindFirstFile(Pointer(szFileName),FindData);
   Result   := (Handle <> INVALID_HANDLE_VALUE);

   if(Result) then Windows.FindClose(Handle);
end;

procedure WriteDebug(const szStr: String; const Param : Boolean);
var
   F    : TextFile;
   Attr : DWord;
const FName = 'debug.txt';
begin
   if Param then begin
      AssignFile(F, FName);
      Attr := GetFileAttributes(FName);
      if ((Attr and FILE_ATTRIBUTE_DIRECTORY	) = FILE_ATTRIBUTE_DIRECTORY) and
         Not ((Attr = $FFFFFFFF)) then
         Exit;
      if (Attr = $FFFFFFFF) then
         ReWrite(F)
      else
         Append(F);
      WriteLn(F, IntToStr(GetTickCount div 1000) + ': ' + szStr);
      Flush(F);
      CloseFile(F);
   end;
end;

function UpperCase(const s: String): String;
var i : Integer;
begin
   Result := '';

   if(length(s) > 0) then begin
      SetLength(Result,length(s));
      for i := 1 to length(s) do
         Result[i] := UpCase(s[i]);
   end;
end;

function LowerCase(const s: String): String;
var i : Integer;
begin
   Result := '';

   if(length(s) > 0) then begin
      SetLength(Result,length(s));
      for i := 1 to length(s) do
         case s[i] of
            'A'..'Z','�','�','�':
               Result[i] := CHR(BYTE(s[i]) + 32);
         else
            Result[i] := s[i];
         end;
   end;
end;

function IntToStr(const i: Int64): string;
var
  Negativ : Boolean;
  Dummy   : Int64;
begin
   Result := '';
   Dummy  := i;
   if Dummy = 0 then
      Result := '0';
   Negativ := Dummy < 0;
   if Negativ then
      Dummy := -Dummy;
   while Dummy > 0 do
   begin
      Result := Char((Dummy mod 10) + Integer('0')) + Result;
      Dummy := Dummy div 10;
   end;
   if Negativ then
      Result := '-' + Result;
end;

function Format(fmt: string; params: array of const): string;
var
   pdw1, pdw2: PDWORD;
   i: integer;
   pc: PCHAR;
begin
   pdw1 := nil;
   if length(params) > 0 then
      GetMem(pdw1, length(params) * sizeof(Pointer));
   pdw2 := pdw1;
   for i := 0 to high(params) do begin
      pdw2^ := DWORD(PDWORD(@params[i])^);
      inc(pdw2);
   end;
   GetMem(pc, 1024 - 1);
   try
      SetString(Result, pc, wvsprintf(pc, PCHAR(fmt), PCHAR(pdw1)));
   except
      Result := '';
   end;
   if (pdw1 <> nil) then
      FreeMem(pdw1);
   if (pc <> nil) then
      FreeMem(pc);
end;

procedure FreeAndNil(var Obj);
var
  Temp: TObject;
begin
  Temp := TObject(Obj);
  Pointer(Obj) := nil;
  Temp.Free;
end;

end.

Gefallen Euch meine sourcen – freue ich mich über Eure Spende – Danke!

Ich habe hier mal ein paar ältere Delphi sourcen eingearbeitet. Die Originale findet Ihr immer noch hier:

X000XBtn.pas
X000XSysUtils.pas
X000XActiveX.pas

(*******************************************************************************
*
* Unit: X000XBtn.pas
* Author: (c) 2004, 2005 – Peter Welz
* Mail: delphi[at]gods4u[dot]de
* Web : delphi.gods4u.de
*
* Information: Diese Unit stellt in WinAPI Programmen eine Button-Klasse zur
* Verf�gung.
* Hilfreich beim Entwickeln von kleineren Tools, die ohne die
* VCL von Borland geschrieben werden, da sich Funktionen einfach
* dem OnClick Ereignis zuweisen lassen.
*
* History:
*******************************************************************************
* Author: Peter Welz
* 2005-08-29: Ein Jpeg kann jetzt aus einer Datei bzw. aus einer Resource
* geladen werden.
* Kleine �nderung an X000XActiveX – hMem in funktionen LoadPicture…
* wird jetzt nicht mehr �ber CreateStreamOnHGlobalX freigegeben,
* sondern es wird im finally block erledigt
* Der MemDC wird jetzt auch wieder freigegeben -
* Doppelte Funktionsaufrufe in den funktionen *JpegResource* und
* *JpegFromFile* habe ich zusammnengefasst
* Kommentar: Um ein Jpeg aus einer Datei zu laden, einfach Property
* Jpeg := ‘filename.jpg’ setzen. Pfadangaben sind notwendig ;o)
* Um ein Jpeg aus einer Resource zu laden, muss die Resource
* vom Typ ‘JPEGDATA’ sein und dem Property Jpeg muss der Name
* der Resource zugeordnet werden z.B.: Jpeg := ‘BILD’;
* TODO: – TabOrder
* – Der “Klick” gef�llt mir noch nicht (bei schnellen Mausklicks
* wirkt der Klick verz�gert)
* – OnMouseOver
* – Property BtnType der Art (Standard-, Color-, Paint-Button)
*******************************************************************************
* weitere Infos am Ende der Unit
*******************************************************************************)

unit X000XBtn;

{.$DEFINE ATOM}

interface

uses Windows, Messages, X000XActiveX;

const
DEBUG = (1=0);

type
TNotifyEvent = procedure(Sender: TObject) of object;

{$IFNDEF ATOM}

{$MESSAGE ‘ATOM ist nicht definiert. Self-Pointer wird im Fenster gespeichert! ‘}

(****************************************************************************)
(* Ich hatte zuerst folgendes implementiert, dann aber irgenwo im Internet *)
(* gelesen, dass es umst�ndlich/nicht richtig ist, sowas im Fenster mit ab- *)
(* zuspeichern. Dort wurde empfohlen, es mit GlobalAddAtom zu l�sen. *)
(* *)
(* Ich habe jetzt beide M�glichkeiten eingebaut, es kann mit Hilfe der *)
(* $DEFINE ATOM Directive zwischen den beiden Methoden ausgew�hlt werden *)
(* *)
(* Die Idee war folgende: *)
(* Ich kann zu jedem Window einen 32-Bit Wert mit abspeichern, der mitge- *)
(* f�hrt wird. (GWL_USERDATA) *)
(* Da ich f�r das Subclassing (WndProc) eine Referenz auf mein Object *)
(* brauchte, habe ich mir gedacht, ich speicher im Fenster (GWL_USERDATA) *)
(* einfach einen Pointer auf eine Datenstruktur ab. Diese Datenstruktur *)
(* enth�lt wiederum Zeiger auf evtl. Objecteigenschaften, oder �hnliches… *)
(* *)
(* Wie an diese Daten kommen? *)
(* PWinProperty(GetWindowLong(hWnd, GWL_USERDATA))^.Self *)
(* Wie diesen Zeiger im Fenster speichern? *)
(* SetWindowLong(hWnd, GWL_USERDATA, Integer(PWinProperty-Struct)); *)
(****************************************************************************)

type
PWinProperty = ^TWinProperty;
TWinProperty = packed Record
Self : Pointer;
//OldWndProc : Pointer;
(* hier eventuell noch mehr Pointer auf Daten/Propertys *)
(* die mit dem Object mitgef�hrt werden sollen… *)
end;
{$ENDIF}

type
TBtnState = (bsUp, bsDown);

type
TX000XBtn = class

private
{$IFNDEF ATOM}
FWinProp : PWinProperty;
{$ENDIF}
FCaption : String;
FHandle : THandle;
FOwner : THandle;
FName : String;
FLeft : Integer;
FTop : Integer;
FWidth : Integer;
FHeight : Integer;
FOnClick : TNotifyEvent;
FBtnState : TBtnState;
FTabStop : Boolean;
FOldWndProc : Pointer;
FIsFocused : Boolean;
FColor : COLORREF;
FdcMemory : HDC;
FJpeg : String;
FFont : HFONT;
FFontName : String;
FFontColor : COLORREF;
FFontSize : Integer;
function GetWidth: Integer;
function GetHeight: Integer;
procedure SetCaption(const Value: String);
procedure SetWidth(const Value: Integer);
procedure SetHeight(const Value: Integer);
function GetTabStop: Boolean;
procedure SetTabStop(const Value: Boolean);
procedure ButtonDraw(ps : PPaintStruct = nil);
procedure WndProc(var Msg: TMessage);
procedure SetColor(const Value: COLORREF);
function SetMethod(Value: Pointer; Data: Pointer = nil): TMethod;
procedure SetupMemDC;
procedure DrawFromMemDC(var pPic: IPicture);
procedure _SetMemDCFromFile(const JpegFileName: String);
procedure _SetMemDCFromRes(const szResName: String);
procedure SetMemDCFromX(const szName: String);
procedure SetFontName(const Value: String);
procedure SetFontColor(const Value: COLORREF);
public
constructor Create(hWndParent: THandle; Position: TPoint);
destructor Destroy; override;
function SetNotifyEvent(Proc: Pointer): TNotifyEvent;
published
property Handle : THandle read FHandle;
property Width : Integer read GetWidth write SetWidth;
property Height : Integer read GetHeight write SetHeight;
property Name : String read FName write FName;
property Caption : String read FCaption write SetCaption;
property OnClick : TNotifyEvent read FOnClick write FOnClick;
property TabStop : Boolean read GetTabStop write SetTabStop;
property Color : COLORREF read FColor write SetColor;
property Jpeg : String read FJpeg write SetMemDCFromX;
property FontColor: COLORREF read FFontColor write SetFontColor;
property FontName : String read FFontName write SetFontName;
end;

{$IFDEF ATOM}
var
FAtom : TAtom;
{$ENDIF}

const
CWIDTH = 100;
CHEIGHT = 27;

implementation

{ TX000XBtn }

uses X000XSysUtils;

type
PFontNameExists = ^TFontNameExists;
TFontNameExists = packed record
Name : String;
Exists : Boolean;
end;

(* function f�r SubClassen des Buttons. Hiermit werden die Nachrichten an das *)
(* Object weitergeleitet. *)
function SetWndProc(hWnd: hWnd; Msg: UINT; wParam: wParam; lParam: lParam): lResult; stdcall;
var
mMsg : TMessage;
Self : TX000XBtn;
begin
(* Parameter in die Message schreiben *)
mMsg.Msg := Msg;
mMsg.wParam := wParam;
mMsg.lParam := lParam;
mMsg.Result := 0;
(* Wir brauchen den Self-Pointer des Objectes, damit wir die Nachrichten an*)
(* selbiges weiterleiten k�nnen. *)
Self := TX000XBtn({$IFDEF ATOM}
GetProp(hWnd, PChar(FAtom))
{$ELSE}
PWinProperty(GetWindowLong(hWnd, GWL_USERDATA))^.Self
{$ENDIF});
(* Und die Nachricht/en an die WndProc des Objectes weiterleiten. *)
Self.WndProc(mMsg);
(* Die WndProc des Objectes setzt das Result, welches wir einfach zur�ck- *)
(* geben. *)
Result := mMsg.Result;
end;

procedure TX000XBtn.WndProc(var Msg: TMessage);
var
ps : TPaintStruct;
dMsg : TMsg;
function InRect: Boolean;
var re : TRect;
pt : TPoint;
begin
pt.X := Msg.LParamLo;
pt.Y := Msg.LParamHi;
GetClientRect(FHandle, re);
Result := ptInRect(re, pt);
end;
begin
(* Result erstmal auf 0 setzen, somit braucht beim behandeln der Nachricht *)
(* nur noch ein Exit mitgegeben werden *)
Msg.Result := 0;
case Msg.Msg of
WM_LBUTTONDOWN:
begin
(* Einmal die Message SETFOCUS rausschicken, damit die anderen *)
(* Buttons auch richtig gezeichnet werden k�nnen *)
SetFocus(FHandle);
(* Alle Mausenachrichten empfangen, auch wenn die Maus nicht *)
(* mehr �ber unserem Control ist. Ist hier n�tig, da wir sonst *)
(* nicht mitbekommen, wenn die Maus losgelassen wird und sich *)
(* nicht mehr �ber unserem Control befindet. *)
SetCapture(FHandle);
(* Nur wenn Maus noch im Bereich des Buttons ist, den Click merken *)
if InRect then begin
FBtnState := bsDown;
//ButtonPaint;
ButtonDraw;
end;
Exit;
end;
WM_MOUSEMOVE:
begin
(* ToDo: andere Farbe zeichnen… OnMouseOver Effekt *)
end;
WM_LBUTTONUP:
begin
(* Nur wenn Maus noch im Bereich des Buttons ist, ist es ein Click *)
if InRect then begin
if Assigned(Self.FOnClick) then begin
FOnClick(Self);
end;
end;
(* Hier auf jedenfall den Click wieder zur�cksetzen, damit die *)
(* Nachrichten wieder an die jeweiligen Controls geschickt werden *)
FBtnState := bsUp;
//ButtonPaint;
ButtonDraw;
(* Und die Maus wieder freigeben, jetzt empfangen elle Controls *)
(* wieder die entsprechenden Nachrichten *)
ReleaseCapture;
Exit;
end;
WM_PAINT:
begin
(* Button zeichnen *)
BeginPaint(FHandle, ps);
(* ToDo: PaintStruct mit �bergeben, somit m�sste nicht das gesamte *)
(* Fenster neu gezeichnet werden *)
ButtonDraw(@ps);
EndPaint(FHandle, ps);
Exit;
end;
WM_KEYDOWN:
begin
if Msg.WParam = 32 then begin
SendMessage(FHandle, WM_LBUTTONDOWN, 0, 0);
Exit;
end;
end;
WM_KEYUP:
begin
if Msg.WParam = 32 then begin
SendMessage(FHandle, WM_LBUTTONUP, 0, 0);
Exit;
end;
end;
WM_SETFOCUS:
begin
FIsFocused := True;
//ButtonPaint;
ButtonDraw;
(* MsgBeep entfernen *)
PeekMessage(dMsg, 0, WM_CHAR, WM_CHAR, PM_REMOVE);
Exit;
end;
WM_KILLFOCUS:
begin
FIsFocused := False;
//ButtonPaint;
ButtonDraw;
Exit;
end;
end;
(* Nachricht an das Hauptfenster zur�ckgeben *)
Msg.Result := CallWindowProc(FOldWndProc, FHandle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

(* Hilfsfunktion, die eine Struktur vom Type TMethod f�llt und zur�ckliefert *)
(* Wird gebraucht, um externe funktionen/proceduren an ein Object �bergeben *)
(* zu k�nnen. (Geh�rt nicht zwingend zu der Klasse) *)
function TX000XBtn.SetMethod(Value: Pointer; Data: Pointer = nil): TMethod;
var Method : TMethod;
begin
Method.Code := Value;
if Assigned(Data) then
Method.Data := Data
else
Method.Data := Self;
Result := Method;
end;

(* Hilfsfunktion, die eine externe function/procedure vom Type TNotifyEvent *)
(* einem Klasseninternen property vom gleichen Type zuweist. *)
(*******************************************************************************
(* Beispiel: *
* *
* procedure Test(Sender: Pointer); *
* begin *
* MessageBox(0, PChar(TX000XBtn(Sender).Caption), ‘Test’, 0); *
* end; *
* *
* // .. *
* *
* Button3 := TX000XBtn.Create(hWnd, Position); *
* Button3.OnClick := Button3.SetNotifyEvent(@Test); *
* *
* // .. *
* *
*******************************************************************************)
function TX000XBtn.SetNotifyEvent(Proc: Pointer): TNotifyEvent;
begin
Result := nil;
if Assigned(Proc) then
Result := TNotifyEvent(SetMethod(Proc));
end;

(* Zeichnet den Button *)
procedure TX000XBtn.ButtonDraw(ps : PPaintStruct = nil);
type
PHDC = ^HDC;
var
Brush : HBRUSH;
dc : PHDC;
cRect : PRect;
begin
(* Initialisieren *)
dc := nil;
cRect := nil;
try
(* Wenn ps <> nil dann benutzen wir HDC und Rect von der �bergebenen *)
(* PaintStruct *)
if Assigned(ps) then begin
cRect := @ps^.rcPaint;
dc := @ps^.hdc;
end else begin
(* Wenn ps = nil dann die Vars erzeugen und Zeiger zuweisen *)
New(dc); New(cRect);
(* und display device context vom Button holen *)
dc^ := GetDC(FHandle);
end;

(* cRect mit Abmessungen vom Button f�llen *)
GetClientRect(FHandle, cRect^);
(* Brush mit Farbe FColor erzeugen *)
Brush := CreateSolidBrush(FColor);
(* F�lle Button mit FColor *)
FillRect(dc^, cRect^, Brush);
(* zum Schluss Freigeben der Resourcen *)
DeleteObject(Brush);
if FJpeg <> ” then begin
(* Kopiere das Bitmap vom Speicher auf den Button (mit Gr��enanpassung) *)
if FBtnState = bsDown then
StretchBlt(dc^, 5, 5, cRect^.Right-10, cRect^.Bottom-10, FdcMemory, 0, 0, CWIDTH, CHEIGHT, SRCCOPY)
else
StretchBlt(dc^, 3, 3, cRect^.Right-6, cRect^.Bottom-6, FdcMemory, 0, 0, CWIDTH, CHEIGHT, SRCCOPY);
end;

(* Button gedr�ckt bzw. oben… dementsprechend die R�nder zeichen *)
if FBtnState = bsDown then
DrawEdge(dc^, cRect^, EDGE_SUNKEN, BF_RECT)
else
DrawEdge(dc^, cRect^, EDGE_RAISED, BF_RECT );

(* Um bei die Textausgabe auch zu animieren, hier das Rechteck versetzen *)
if FBtnState = bsDown then begin
cRect^.Left := -2;
cRect^.Top := -2;
cRect^.Right := cRect^.Right – 2;
cRect^.Bottom := cRect^.Bottom – 2;
end;

(* Textausgabe *)
SelectObject(dc^, FFont);
SetBKMode(dc^, {OPAQUE}TRANSPARENT);
SetTextAlign(dc^, TA_CENTER);
SetTextColor(dc^, FFontColor);
TextOut(dc^, cRect^.Right div 2, cRect^.Top + 6, Pointer(Self.Caption), Length(Self.Caption));

(* FocusRect zeichnen, wenn Button den Focus besitzt *)
if FIsFocused then begin
if FBtnState = bsDown then begin
cRect^.Left := -1;
cRect^.Top := -1;
InflateRect(cRect^, -4, -4);
DrawFocusRect(dc^, cRect^);
end else begin
cRect^.Right := cRect^.Right +1;
cRect^.Bottom := cRect^.Bottom +1;
InflateRect(cRect^, -5, -5);
DrawFocusRect(dc^, cRect^);
end;
end;
finally
(* Wenn ps nil war, haben wir ja Speicher reserviert, den wir jetzt freigeben *)
if Not Assigned(ps) then begin
Dispose(cRect);
ReleaseDC(FHandle, dc^);
Dispose(dc);
end;
end;
end;

(* Initialisieren der Variablen und Erstellen des Buttons; zuweisen der WndProc *)
constructor TX000XBtn.Create(hWndParent: THandle; Position: TPoint);
var TmpHwnd : THandle;
i : Integer;
begin
{$IFDEF ATOM}
FAtom := GlobalAddAtom(‘X000XBtn’);
{$ELSE}
FWinProp := GetMemory(SizeOf(TWinProperty));
FillChar(FWinProp^, SizeOf(TWinProperty), #0);
{$ENDIF}

FOnClick := nil;
FBtnState := bsUp;
FOwner := hWndParent;
FLeft := Position.X;
FTop := Position.Y;
FWidth := CWIDTH;
FHeight := CHEIGHT;
FIsFocused := False;
FColor := $00656059; //$00D4A062;
FJpeg := ”;
FdcMemory := 0;
FFontName := ‘Courier New’;
FFontColor := $00FFFFFF;
FFontSize := -12;
FFont := CreateFont(FFontSize, 0, 0, 0, FW_NORMAL, 0, 0, 0, ANSI_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH, Pointer(FFontName));
i := 1;
(* Alle bisher erstellten Buttons z�hlen, damit der Defaultname durch- *)
(* nummeriert gesetzt werden kann. z.B. Button1, Button2 usw. *)
//EnumChildWindows(hWndParent)
TmpHwnd := FindWindowEx(Self.FOwner, 0, ‘BUTTON’, nil);
while (TmpHwnd <> 0) do begin
TmpHwnd := FindWindowEx(Self.FOwner, TmpHwnd, ‘BUTTON’, nil);
inc(i)
end;
FName := ‘X000XButton’ + IntToStr(i);

FCaption := FName;
(* Erstellen des Fensters *)
FHandle := CreateWindowEx(0, ‘BUTTON’, Pointer(FName), WS_VISIBLE or WS_CHILD or BS_OWNERDRAW or BS_CENTER,
FLeft, FTop,
FWidth, FHeight, hWndParent, 0, hInstance, nil);

(* Neue WndProc f�r dieses Fenster setzen und dabei den Zeiger auf die *)
(* originale WndProc merken (Entweder im Fenster selber, bzw. als Property *)
(* (zu Identifizieren �ber FAtom) *)
FOldWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC, Integer(@SetWndProc)));

{$IFDEF ATOM}
SetProp(FHandle, PChar(FAtom), Cardinal(Self));
{$ELSE}
FWinProp.Self := Self;

SetWindowLong(FHandle, GWL_USERDATA, Integer(FWinProp));
{$ENDIF}
end;

(* Reservierten Speicher etc. frei geben, Fenster zerst�ren *)
destructor TX000XBtn.Destroy;
begin
(* Schriftenhandle freigeben *)
DeleteObject(FFont);

(* MemoryDC wieder freigeben *)
if FdcMemory <> 0 then
DeleteDc(FdcMemory);

{$IFDEF ATOM}
(* Zuerst die WndProc vom Mainwindow wieder benutzen, damit wir *)
(* gefahrlos das Property entfernen k�nnen… *)
(* ( Unsere BtnWndProc w�rde das Property ja ben�tigen, um *)
(* das Fenster zu zerst�ren ) *)
SetWindowLongPtr(FHandle, GWLP_WNDPROC, Integer(FOldWndProc));
(* Jetzt k�nnen wir auch gefahrlos das Property entfernen, es *)
(* wird ja nicht mehr gebraucht *)
RemoveProp(FHandle, PChar(FAtom));
{$ENDIF}

(* Handle/Fenster zerst�ren *)
DestroyWindow(FHandle);

{$IFDEF ATOM}
(* und zum Schluss auch noch den Referenzz�hler decrementieren *)
(* bzw. das Atom aus der GlobalAtomTable l�schen *)
GlobalDeleteAtom(FAtom);
{$ELSE}
FreeMemory(FWinProp);
{$ENDIF}
inherited;
end;

(*******************************************************************************
* *
* Folgende Funktionen dienen dem Setzen der Propertys und sind *
* selbsterkl�rend *
* *
*******************************************************************************)
function TX000XBtn.GetHeight: Integer;
begin
Result := FHeight;
end;

function TX000XBtn.GetTabStop: Boolean;
begin
FTabSTop := (GetWindowLong(FHandle, GWL_STYLE) and WS_TABSTOP) = WS_TABSTOP;
Result := FTabStop;
end;

function TX000XBtn.GetWidth: Integer;
begin
Result := FWidth;
end;

procedure TX000XBtn.SetCaption(const Value: String);
begin
if FCaption <> Value then begin
FCaption := Value;
SendMessage(FHandle, WM_SETTEXT, 0, LPARAM(FCaption));
end;
end;

procedure TX000XBtn.SetHeight(const Value: Integer);
begin
if FHeight <> Value then begin
FHeight := Value;
MoveWindow(FHandle, FLeft, FTop, FWidth, FHeight, True);
end;
end;

procedure TX000XBtn.SetTabStop(const Value: Boolean);
begin
if FTabStop <> Value then begin
if Value then begin
(* WS_TABSTOP setzen *)
SetWindowLong(FHandle, GWL_STYLE, GetWindowLong(FHandle, GWL_STYLE) or WS_TABSTOP);
end else
(* WS_TABSTOP entfernen *)
SetWindowLong(FHandle, GWL_STYLE, GetWindowLong(FHandle, GWL_STYLE) xor WS_TABSTOP);
FTabStop := Value;
end;
end;

procedure TX000XBtn.SetWidth(const Value: Integer);
begin
if FWidth <> Value then begin
FWidth := Value;
MoveWindow(FHandle, FLeft, FTop, FWidth, FHeight, True);
end;
end;

procedure TX000XBtn.SetColor(const Value: COLORREF);
begin
if Value <> FColor then begin
FColor := Value;
UpdateWindow(FHandle);
end;
end;

procedure TX000XBtn.SetupMemDC;
var dc : HDC;
hBmp : HBITMAP;
begin
(* Den MemDC nur einmal erstellen/initialisieren *)
if FdcMemory = 0 then begin
(* Erstelle “Zeichenger�t” im Speicher (kompatibel zur Anzeige) *)
FdcMemory := CreateCompatibleDC(0);
(* Hole Zeichenger�t vom Button *)
dc := GetDC(FHandle);
(* Erstelle Bitmap (kompatibel zum Zeichenger�t des Buttons) *)
hBmp := CreateCompatibleBitmap(dc, FWidth, FHeight);
(* wir wollen ein Bitmap im Speicher abbilden *)
SelectObject(FdcMemory, hBmp);
(* Das originale Bitmap brauchen wir nicht mehr, also freigeben *)
DeleteObject(hBmp);
(* Das Zeichenger�t vom Button auch nicht, also auch freigeben *)
ReleaseDC(FHandle, dc);
end;
end;

procedure TX000XBtn.DrawFromMemDC(var pPic: IPicture);
var
hmWidth,
hmHeight : Integer;
rc : TRect;
begin
if Assigned(pPic) then begin
(* originale Ma�e vom Picture holen *)
if (pPic.get_Width(hmWidth) = S_OK) then
if (pPic.get_Height(hmHeight) = S_OK) then begin
(* Ein Rechteck erstellen, mit den Abma�en vom Button *)
GetWindowRect(FHandle, rc);
(* und letztendlich das Bild “in den Speicher zeichnen” *)
pPic.Render(FdcMemory, 0, 0, FWidth, FHeight, 0, hmHeight, hmWidth, -hmHeight, rc);
(* damit gleich aktualisiert wird *)
ButtonDraw;
end;
end;
end;

procedure TX000XBtn._SetMemDCFromFile(const JpegFileName: String);
var pPic : IPicture;
begin
(* mit dem laden des Bildes anfangen *)
if (LoadPictureFromFile(JpegFileName, pPic)) then begin
SetupMemDC;
DrawFromMemDC(pPic);
end;
end;

procedure TX000XBtn._SetMemDCFromRes(const szResName: String);
var pPic : IPicture;
begin
(* mit dem laden des Bildes anfangen *)
if (LoadPictureFromRes(hInstance, szResName, ‘JPEGDATA’, pPic)) then begin
SetupMemDC;
DrawFromMemDC(pPic);
end;
end;

procedure TX000XBtn.SetMemDCFromX(const szName: String);
begin
if FJpeg <> szName then begin
FJpeg := szName;
if FileExists(szName) then
_SetMemDCFromFile(szName)
else
_SetMemDCFromRes(szName);
end;
end;

procedure TX000XBtn.SetFontName(const Value: String);
(* CallBack function von EnumFonts… Mit Hilfe des Typs TFontNameExists *)
(* erkennen wir, ob die gew�nschte Schrifft �berhaupt verf�gbar ist *)
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
begin
if lstrcmpi(Pointer(TFontNameExists(Data^).Name), LogFont.lfFaceName) = 0 then begin
TFontNameExists(Data^).Exists := True;
(* Der Name wurde gefunden, also aussteigen *)
Result := 0;
end else
(* Der Name wurde noch nicht gefunden, also mit dem n�chsten Fontname weitermachen *)
(* solange jedenfalls noch welche zum vergleichen da sind… *)
Result := 1;
end;
var
Tmp : PFontNameExists;
dc : HDC;
begin
if (FFontName <> Value) and (Value <> ”) then begin
(* Neue Variable erzeugen *)
New(Tmp);
try
(* Unsren Typ mit dem Fontnamen den wir suchen f�llen *)
Tmp.Name := Value;
(* und auf False setzen *)
Tmp.Exists := False;
dc := GetDC(0);
(* steht hiernach die BooleanVar unsres Typs auf True, gibt es die Schrift im System *)
EnumFonts(dc, nil, @EnumFontsProc, Pointer(Tmp));
ReleaseDC(0, dc);
(* und nur in diesem fall �ndern wir die Schrift *)
if Tmp.Exists then begin
(* Altes Object zerst�ren *)
DeleteObject(FFont);
(* Neuen Namen setzen *)
FFontName := Value;
(* und ein Handle auf die Schrift holen *)
FFont := CreateFont(FFontSize, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH, Pointer(FFontName));
end;
(* damit wir auch sofort was sehen, den Button neu zeichnen lassen *)
ButtonDraw;
finally
(* Speicher von Tmp freigeben *)
Dispose(Tmp);
end;
end;
end;

procedure TX000XBtn.SetFontColor(const Value: COLORREF);
begin
if FFontColor <> Value then begin
FFontColor := value;
ButtonDraw;
end;
end;

{$WARNINGS OFF}
end.
(*******************************************************************************
* Author: Peter Welz
* 2005-08-18: X000XActiveX angef�gt, um Pictures in die Buttons laden zu
* k�nnen
* FJpeg eingef�hrt, d.h. dem Button kann jetzt ein Jpeg Image
* zugewiesen werden.
* Procedure ButtonDraw um FJpeg erweitert
* Kommentar: X000XActiveX beinhaltet einen Teil der Delphi �bersetzung
* von OCIDL.H bzw. OBJIDL.H speziell IPicture und IStream
* wird aber dynamisch geladen.
* TODO: – TabOrder
* – Der “Klick” gef�llt mir noch nicht (bei schnellen Mausklicks
* wirkt der Klick verz�gert)
* – Bilder aus Resource (im Moment nur aus Datei)
* – OnMouseOver
* – Property BtnType der Art (Standard-, Color-, Paint-Button)
*******************************************************************************
* Author: Peter Welz
* 2005-08-15: Proceduren ButtonDraw und ButtonPaint zu einer zusammengefasst
* –> ButtonDraw
* Kommentar:
* TODO: – TabOrder
* – Bilder
* – OnMouseOver
* – Property BtnType der Art (Standard-, Color-, Paint-Button)
*******************************************************************************
* Author: Peter Welz
* 2005-08-14: Quelltext Kommentierung vervollst�ndigt, unn�tige Kommentare
* entfernt.
* Kommentar:
* TODO: – TabOrder
* – Bilder
* – OnMouseOver
* – Property BtnType der Art (Standard-, Color-, Paint-Button)
*******************************************************************************
* Author: Peter Welz
* 2005-07-12: OnClick Ereignis kann jetzt von Aussen zugewiesen werden…
* Kommentar: Endlich bin ich dazu mal gekommen, jetzt macht der ganze
* Quatsch erst richtig Sinn…
* procedure Test(Sender: Pointer);
* begin
* MessageBox(hWnd, PChar(TX000XBtn(Sender).Caption), ‘Test’, 0);
* end;
*
* // ..
*
* Button3 := TX000XBtn.Create(hWnd, Position);
* Button3.OnClick := Button3.SetNotifyEvent(@Test);
*
* // ..
* TODO: – TabOrder
* – Bilder
* – Property BtnType der Art (Standard-, Color-, Paint-Button)
*******************************************************************************
* Author: Peter Welz
* 2005-01-17: FColor, FTabStop implementiert, hierbei ist der Standard
* Button rausgeflogen
* Kommentar:
* TODO: – TabOrder
* – Bilder
* – Property BtnType der Art (Standard-, Color-, Paint-Button)
* – OnClick Ereignis von Au�en zuweisen
*******************************************************************************
* Author: Peter Welz
* 2004-09-18: Das Speichern des Self-Pointers umgestellt.
* OldWndProc aus TWinProperty in den gesch�tzten Teil der Klasse
* gesteckt (FOldWndProc)
* Globale VAR FAtom eingef�hrt
* Anhand der Compilerdirective $DEFINE ATOM wird unterschieden,
* welche Variante zum speichern des Self-Pointers genutzt wird.
* Kommentar: Der pointer wird jetzt nicht mehr in GWL_USERDATA gehalten,
* sondern in der “Fenstereigenschaften Liste”
* (siehe MSDN —> Set/GetProp)
* Den Zeiger auf die Originale WndProc brauchte ich nicht mehr
* in TWinProperty speichern, da ich ja sowieso an die Klassen-
* eigenschaften rankomme. Somit brauche ich nur einen Zeiger
* mitf�hren, ich denke mal, die PropertyList ist genau daf�r
* gedacht.
* TODO: – OnClick Ereignis von Au�en zuweisen
* – Farben
* – Bilder
* – TabStop
* – TabOrder
*******************************************************************************
* Author: Peter Welz
* 2004-09-16: Implementierung einer Fensterprocedure die anhand des Self-
* Pointers die richtige Objectinstanz erkennt… Jetzt macht die
* Klasse erst Sinn, da jetzt “unendlich” viele Buttons erzeugt
* und deren Messages verarbeitet werden k�nnen.
* Kommentar: Zu jedem Fenster (Buttons sind auch nur Fenster) kann der
* Entwickler einen eigenen 32-Bit Wert (4 Byte) abspeichern.
* —> Stichwort: GWL_USERDATA (siehe: MSDN) <—
* Solange das Fenster existiert, existiert auch dieser Wert.
* Genau sowas hatte mir gefehlt, um an die Referenz des Objectes
* zu kommen. Ich speicher jetzt einfach den Selfpointer und
* den Pointer auf die Original WndProc in einer Struktur (siehe
* TWinProperty). In dem Fenster selber speicher (s.o.) ich einen
* Pointer auf diese Struktur. Somit bin ich in der Lage,
* jeder Zeit an mein Object zu kommen, also auch in der WndProc.
* TODO: – OnClick Ereignis von Au�en zuweisen
* – Farben
* – Bilder
* – TabStop
* – TabOrder
*******************************************************************************
* Author: Peter Welz
* 2004-08-14: Erstellen der Klasse, Windows Standard-Button
* Kommentar: Es kann bis jetzt nur ein Button erstellt werden, da die
* Nachrichten f�r den Button noch nicht �ber die Klasse ge-
* h�ndelt werden. Habe noch keinen Weg gefunden, wie ich
* in der WndProc Funktion des Buttons an die Referenz des
* Objektes rankomme.
* TODO: – Eigene WndProc f�r die Klasse (WICHTIG, da sonst Sinnlos)
* – OnClick Ereignis von Au�en zuweisen
* – Farben
* – Bilder
* – TabStop
* – TabOrder
*******************************************************************************)

Gefallen Euch meine sourcen – freue ich mich über Eure Spende – Danke!