diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 08:54:39 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 08:54:39 +0000 |
commit | 1e00430227e56fd2691f8374418f352c171039b1 (patch) | |
tree | 0451194af432a8b80270defb403bb100f1e95d90 /prototypes | |
parent | 2ecc101eb1573c272d570289987807c44937631b (diff) | |
download | fpGUI-1e00430227e56fd2691f8374418f352c171039b1.tar.xz |
The first part of removing the obsolete fpGUI and replacing it with the new multi-handle design from the prototypes directory.
Diffstat (limited to 'prototypes')
45 files changed, 0 insertions, 18809 deletions
diff --git a/prototypes/fpgui2/source/core/fpgfx.pas b/prototypes/fpgui2/source/core/fpgfx.pas deleted file mode 100644 index 6f8af25f..00000000 --- a/prototypes/fpgui2/source/core/fpgfx.pas +++ /dev/null @@ -1,1080 +0,0 @@ -unit fpgfx; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - gfxbase - // This is the only place we have such IFDEF!!! Is this ok, or must be - // implement it like we have done for the previous version of fpGFX? - {$IFDEF MSWINDOWS} - ,gfx_gdi - {$ENDIF} - {$IFDEF UNIX} - ,gfx_x11 - {$ENDIF} - ; - -type - TOrientation = (orVertical, orHorizontal); - - TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient); - - TAnchor = (anLeft, anRight, anTop, anBottom); - TAnchors = set of TAnchor; - - TClipboardKeyType = (ckNone, ckCopy, ckPaste, ckCut); - - TFButtonFlags = set of (btnIsEmbedded, btnIsDefault, btnIsPressed, - btnIsSelected, btnHasFocus, btnHasParentColor); - - TMouseButton = (mbLeft, mbRight, mbMiddle); - - -const - AllAnchors = [anLeft, anRight, anTop, anBottom]; - - // Used for the internal message queue - cMessageQueueSize = 512; - - -type - { ******************************************* - Internal event properties: Event Types - *******************************************} - TIntKeyPressEvent = procedure(Sender: TObject; var keycode: word; var shiftstate: word; - var consumed: boolean) of object; - TIntMouseEvent = procedure(Sender: TObject; x, y: TfpgCoord; var button: word; - var shiftstate: word) of object; - - - { ******************************************* - Public event properties: Event Types - *******************************************} - { Keyboard } - TKeyEvent = procedure(Sender: TObject; AKey: Word; AShift: TShiftState) of object; - TKeyCharEvent = procedure(Sender: TObject; AKeyChar: Char) of object; - { Mouse } - TMouseButtonEvent = procedure(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint) of object; - TMouseMoveEvent = procedure(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint) of object; - TMouseWheelEvent = procedure(Sender: TObject; AShift: TShiftState; AWheelDelta: Single; const AMousePos: TPoint) of object; - { Painting } - TPaintEvent = procedure(Sender: TObject{; const ARect: TfpgRect}) of object; - -type - TSizeParams = record - min_width: TfpgCoord; - max_width: TfpgCoord; - min_height: TfpgCoord; - max_height: TfpgCoord; - end; - - - TfpgFontResource = class(TfpgFontResourceImpl) - protected - FFontDesc: string; - FRefCount: integer; - public - constructor Create(const afontdesc: string); - function IncRefCount: integer; - function DecRefCount: integer; - property FontDesc: string read FFontDesc; - end; - - - TfpgFont = class(TfpgFontBase) - public - constructor Create(afontres: TfpgFontResource; const afontdesc: string); - destructor Destroy; override; - end; - - - // forward declaration - TfpgCanvas = class; - - - TfpgWindow = class(TfpgWindowImpl) - protected - procedure SetParent(const AValue: TfpgWindow); reintroduce; - function GetParent: TfpgWindow; reintroduce; - function GetCanvas: TfpgCanvas; reintroduce; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property Parent: TfpgWindow read GetParent write SetParent; - property Canvas: TfpgCanvas read GetCanvas; - property WinHandle; // surface this property from TfpgXXXImpl class in it's native format - end; - - - TfpgImage = class(TfpgImageImpl) - public - function ImageFromRect(var ARect: TRect): TfpgImage; - end; - - - TfpgImages = class - private - FImages: TStringList; - public - constructor Create; - destructor Destroy; override; - function AddImage(const imgid: string; img: TfpgImage): boolean; - function DeleteImage(const imgid: string; freeimg: boolean): boolean; - function GetImage(const imgid: string): TfpgImage; - function AddBMP(const imgid: string; bmpdata: pointer; bmpsize: integer): TfpgImage; - function AddMaskedBMP(const imgid: string; bmpdata: pointer; bmpsize: integer; mcx, mcy: integer): TfpgImage; - procedure ListImages(var sl: TStringList); - end; - - - TfpgCanvas = class(TfpgCanvasImpl) - public - constructor Create(awin: TfpgWindow); reintroduce; - destructor Destroy; override; - procedure DrawButtonFace(x, y, w, h: TfpgCoord; AFlags: TFButtonFlags); - procedure DrawControlFrame(x, y, w, h: TfpgCoord); - procedure DrawDirectionArrow(x, y, w, h: TfpgCoord; direction: integer); - end; - - - { This is very basic for now, just to remind us of theming support. Later we - will rework this to use a Style Manager like the previous fpGUI. Styles must - also move out of fpGFX. Also support Bitmap based styles for easier theme - implementations. } - TfpgStyle = class - public - DefaultFont: TfpgFont; - MenuFont: TfpgFont; - MenuAccelFont: TfpgFont; - MenuDisabledFont: TfpgFont; - public - constructor Create; virtual; - procedure DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags); virtual; - procedure DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); virtual; - procedure DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: integer); virtual; - end; - - - TfpgApplication = class(TfpgApplicationImpl) - protected - FDisplayParams: string; - FScreenWidth: integer; - FScreenHeight: integer; - FDefaultFont: TfpgFont; - FFontResList: TList; - procedure FreeFontRes(afontres: TfpgFontResource); - procedure InternalInit; - procedure RunMessageLoop; - procedure WaitWindowMessage(atimeoutms: integer); - public - constructor Create(const aparams: string = ''); override; - destructor Destroy; override; - function GetFont(const afontdesc: string): TfpgFont; - procedure Initialize; - procedure Run; - procedure Flush; - procedure ProcessMessages; - property ScreenWidth: integer read FScreenWidth; - property ScreenHeight: integer read FScreenHeight; - property DefaultFont: TfpgFont read FDefaultFont; - end; - - - { TfpgTimer } - - TfpgTimer = class - private - FEnabled: boolean; - FNextAlarm: TDateTime; - FInterval: integer; - FOnTimer: TNotifyEvent; - procedure SetEnabled(const AValue: boolean); - procedure SetInterval(const AValue: integer); - public - constructor Create(ainterval: integer); - destructor Destroy; override; - procedure CheckAlarm(ctime: TDateTime); - property Enabled: boolean read FEnabled write SetEnabled; - property NextAlarm: TDateTime read FNextAlarm; - property Interval: integer read FInterval write SetInterval; - property OnTimer: TNotifyEvent read FOnTimer write FOnTimer; - end; - - - { Caret (text cursor). Inverts painting over text and has blinking - support. } - TfpgCaret = class - private - FEnabled: boolean; - FVisible: boolean; - FInterval: integer; - FCanvas: TfpgCanvas; - FTop: TfpgCoord; - FLeft: TfpgCoord; - FWidth: TfpgCoord; - FHeight: TfpgCoord; - FTimer: TfpgTimer; - procedure OnTimerTime(Sender: TObject); - public - constructor Create; - destructor Destroy; override; - procedure SetCaret(acanvas: TfpgCanvas; x, y, w, h: TfpgCoord); - procedure UnSetCaret(acanvas: TfpgCanvas); - procedure InvertCaret; - end; - -var - fpgStyle: TfpgStyle; // move this into fpgApplication - fpgCaret: TfpgCaret; // move this into fpgApplication - fpgImages: TfpgImages; // move this into fpgApplication - -// Application singleton -function fpgApplication: TfpgApplication; - -// Fonts (easy access function) -function fpgGetFont(const afontdesc: string): TfpgFont; - -// Message Queue (easy access function) -procedure fpgWaitWindowMessage; -procedure fpgPostMessage(Sender, Dest: TObject; MsgCode: integer; var aparams: TfpgMessageParams); overload; -procedure fpgPostMessage(Sender, Dest: TObject; MsgCode: integer); overload; -procedure fpgSendMessage(Sender, Dest: TObject; MsgCode: integer; var aparams: TfpgMessageParams); overload; -procedure fpgSendMessage(Sender, Dest: TObject; MsgCode: integer); overload; -procedure fpgDeliverMessage(var msg: TfpgMessageRec); -procedure fpgDeliverMessages; -function fpgGetFirstMessage: PfpgMessageRec; -procedure fpgDeleteFirstMessage; - -// Color routines -function fpgColorToRGB(col: TfpgColor): TfpgColor; -function fpgGetNamedColor(col: TfpgColor): TfpgColor; -procedure fpgSetNamedColor(colorid, rgbvalue: longword); -function fpgGetNamedFontDesc(afontid: string): string; -procedure fpgSetNamedFont(afontid, afontdesc: string); - -// Timers rountines -procedure fpgInitTimers; -procedure fpgCheckTimers; -function fpgClosestTimer(ctime: TDateTime; amaxtime: integer): integer; - - -implementation - -uses - gfx_imgfmt_bmp, - gfx_stdimages; - -var - fpgTimers: TList; - fpgNamedColors: array[0..255] of TfpgColor; - fpgNamedFonts: TList; - uApplication: TfpgApplication; - -const - ONE_MILISEC = 1 / (24 * 60 * 60 * 1000); - -type - TNamedFontItem = class - public - FontID: string; - FontDesc: string; - constructor Create(AFontID, AFontDesc: string); - end; - -constructor TNamedFontItem.Create(AFontID, AFontDesc: string); -begin - FontID := AFontID; - FontDesc := AFontDesc; -end; - -{$include gfx_msgqueue.inc} - -// Timer support - -procedure fpgInitTimers; -begin - if fpgTimers = nil then - fpgTimers := TList.Create; -end; - -procedure fpgCheckTimers; -var - n: integer; - ctime: TDateTime; -begin - ctime := now; - for n := 1 to fpgTimers.Count do - TfpgTimer(fpgTimers[n - 1]).CheckAlarm(ctime); -end; - -function fpgClosestTimer(ctime: TDateTime; amaxtime: integer): integer; -var - n: integer; - t: TfpgTimer; - dt: TDateTime; -begin - dt := ctime + amaxtime * ONE_MILISEC; - - for n := 1 to fpgTimers.Count do - begin - t := TfpgTimer(fpgTimers[n - 1]); - if t.Enabled and (t.NextAlarm < dt) then - dt := t.NextAlarm; - end; - - Result := trunc(0.5 + (dt - ctime) / ONE_MILISEC); - if Result < 0 then - Result := 0; -end; - -procedure TfpgTimer.SetEnabled(const AValue: boolean); -begin - if not FEnabled and AValue then - FNextAlarm := now + interval * ONE_MILISEC; - FEnabled := AValue; -end; - -procedure TfpgTimer.SetInterval(const AValue: integer); -begin - FInterval := AValue; - FNextAlarm := now + FInterval * ONE_MILISEC; -end; - -constructor TfpgTimer.Create(ainterval: integer); -begin - FInterval := ainterval; - OnTimer := nil; - FEnabled := False; - fpgTimers.Add(self); -end; - -destructor TfpgTimer.Destroy; -var - i: integer; -begin - i := fpgTimers.IndexOf(self); - if i >= 0 then - fpgTimers.Delete(i); - inherited Destroy; -end; - -procedure TfpgTimer.CheckAlarm(ctime: TDateTime); -begin - if not FEnabled then - Exit; - - if FNextAlarm <= ctime then - begin - // set the next alarm point - if interval > 0 then - while FNextAlarm <= ctime do - FNextAlarm := FNextAlarm + interval * ONE_MILISEC; - - if Assigned(OnTimer) then - OnTimer(self); - end; -end; - -function fpgApplication: TfpgApplication; -begin - if not Assigned(uApplication) then - uApplication := TfpgApplication.Create; - result := uApplication; -end; - -function fpgColorToRGB(col: TfpgColor): TfpgColor; -begin - if (col and $80000000) <> 0 then - Result := fpgNamedColors[col and $FF] or (col and $7F000000)// named color keeping alpha - else - Result := col; -end; - -function fpgGetNamedColor(col: TfpgColor): TfpgColor; -begin - Result := fpgNamedColors[col and $FF]; -end; - -procedure fpgSetNamedColor(colorid, rgbvalue: longword); -var - i: longword; -begin - if (colorid and $80000000) = 0 then - Exit; - i := colorid and $FF; - fpgNamedColors[i] := rgbvalue; -end; - -function fpgGetNamedFontDesc(afontid: string): string; -var - n: integer; -begin - for n := 0 to fpgNamedFonts.Count - 1 do - if (lowercase(TNamedFontItem(fpgNamedFonts[n]).FontID) = lowercase(afontid)) then - begin // found - Result := TNamedFontItem(fpgNamedFonts[n]).FontDesc; - Exit; //==> - end; - - Writeln('GetNamedFontDesc error: "' + afontid + '" is missing. Default is used.'); - Result := FPG_DEFAULT_FONT_DESC; -end; - -procedure fpgSetNamedFont(afontid, afontdesc: string); -var - n: integer; -begin - n := 0; - while (n < fpgNamedFonts.Count) and (lowercase(TNamedFontItem(fpgNamedFonts[n]).FontID) <> lowercase(afontid)) do - Inc(n); - - if n < fpgNamedFonts.Count then - TNamedFontItem(fpgNamedFonts[n]).FontDesc := afontdesc// already defined - - else - fpgNamedFonts.Add(TNamedFontItem.Create(afontid, afontdesc)); -end; - -procedure fpgWaitWindowMessage; -begin - fpgApplication.WaitWindowMessage(0); -end; - -function fpgGetFont(const afontdesc: string): TfpgFont; -begin - Result := fpgApplication.GetFont(afontdesc); -end; - -constructor TfpgApplication.Create(const aparams: string); -begin - FFontResList := TList.Create; - FDisplayParams := aparams; - FScreenWidth := -1; - FScreenHeight := -1; - - inherited Create(aparams); - - if IsInitialized then - begin - FScreenWidth := GetScreenWidth; - FScreenHeight := GetScreenHeight; - end; - - FDefaultFont := GetFont(FPG_DEFAULT_FONT_DESC); -end; - -destructor TfpgApplication.Destroy; -var - i: integer; -begin - for i := 0 to (fpgNamedFonts.Count - 1) do - TNamedFontItem(fpgNamedFonts.Items[i]).Free; - fpgNamedFonts.Free; - - fpgImages.Free; - - FFontResList.Free; - inherited Destroy; -end; - -function TfpgApplication.GetFont(const afontdesc: string): TfpgFont; -var - fr: TfpgFontResource; - n: integer; - fdesc: string; -begin - fdesc := afontdesc; - - if copy(fdesc, 1, 1) = '#' then - fdesc := fpgGetNamedFontDesc(copy(afontdesc, 2, length(afontdesc))); - - Result := nil; - - for n := 0 to FFontResList.Count - 1 do - if TfpgFontResource(FFontResList[n]).FontDesc = fdesc then - begin - fr := TfpgFontResource(FFontResList[n]); - Inc(fr.FRefCount); - Result := TfpgFont.Create(fr, afontdesc); - Exit; //==> - end; - - fr := TfpgFontResource.Create(fdesc); - - if fr.HandleIsValid then - begin - FFontResList.Add(fr); - Result := TfpgFont.Create(fr, afontdesc); - end - else - begin - fr.Free; - writeln('error opening font.'); - end; -end; - -procedure TfpgApplication.Initialize; -begin - {$Note remember to process parameter!! } - if IsInitialized then - InternalInit - else - raise Exception.Create('Failed in initialize the Application object!'); -end; - -procedure TfpgApplication.Run; -begin - RunMessageLoop; -end; - -procedure TfpgApplication.FreeFontRes(afontres: TfpgFontResource); -var - n: integer; -begin - for n := 0 to FFontResList.Count - 1 do - if FFontResList[n] = Pointer(afontres) then - begin - TfpgFontResource(FFontResList[n]).Free; - FFontResList.Delete(n); - Exit; - end; -end; - -procedure TfpgApplication.InternalInit; -begin - fpgInitTimers; - fpgNamedFonts := TList.Create; - fpgStyle := TfpgStyle.Create; - fpgCaret := TfpgCaret.Create; - fpgImages := TfpgImages.Create; - fpgCreateStandardImages; -end; - -procedure TfpgApplication.Flush; -begin - DoFlush; -end; - -procedure TfpgApplication.ProcessMessages; -begin - Flush; - while DoMessagesPending do - begin - WaitWindowMessage(0); - Flush; - end; -end; - -procedure TfpgApplication.WaitWindowMessage(atimeoutms: integer); -begin - DoWaitWindowMessage(fpgClosestTimer(now, atimeoutms)); - fpgDeliverMessages; - fpgCheckTimers; -end; - -procedure TfpgApplication.RunMessageLoop; -begin - repeat - WaitWindowMessage(1000); - until False; -end; - -{ TfpgFont } - -constructor TfpgFont.Create(afontres: TfpgFontResource; const afontdesc: string); -begin - FFontRes := afontres; - FFontDesc := afontdesc; - afontres.IncRefCount; -end; - -destructor TfpgFont.Destroy; -begin - if TfpgFontResource(FFontRes).DecRefCount <= 0 then - fpgApplication.FreeFontRes(TfpgFontResource(FFontRes)); - - inherited; -end; - -{ TfpgFontResource } - -constructor TfpgFontResource.Create(const afontdesc: string); -begin - inherited; - FFontDesc := afontdesc; - FRefCount := 0; -end; - -function TfpgFontResource.DecRefCount: integer; -begin - Dec(FRefCount); - Result := FRefCount; -end; - -function TfpgFontResource.IncRefCount: integer; -begin - Inc(FRefCount); - Result := FRefCount; -end; - -{ TfpgCanvas } - -constructor TfpgCanvas.Create(awin: TfpgWindow); -begin - inherited Create; - - FBeginDrawCount := 0; - FWindow := awin; - - // options - FBufferedDraw := True; // transparent widgets must turn this off - FPersistentResources := False; -end; - -destructor TfpgCanvas.Destroy; -begin - if fpgCaret.FCanvas = self then - fpgCaret.UnSetCaret(self); - inherited Destroy; -end; - -procedure TfpgCanvas.DrawButtonFace(x, y, w, h: TfpgCoord; AFlags: TFButtonFlags); -begin - fpgStyle.DrawButtonFace(self, x, y, w, h, AFlags); -end; - -procedure TfpgCanvas.DrawControlFrame(x, y, w, h: TfpgCoord); -begin - fpgStyle.DrawControlFrame(self, x, y, w, h); -end; - -procedure TfpgCanvas.DrawDirectionArrow(x, y, w, h: TfpgCoord; direction: integer); -begin - fpgStyle.DrawDirectionArrow(self, x, y, w, h, direction); -end; - -{ TfpgWindow } - -constructor TfpgWindow.Create(AOwner: TComponent); -begin - inherited Create(AOwner); // initialize the platform internals - - FTop := 0; - FLeft := 0; - FWidth := 16; - FHeight := 16; - - FMinWidth := 2; - FMinHeight := 2; - - FModalForWin := nil; - - if (AOwner <> nil) and (AOwner is TfpgWindow) then - FWindowType := wtChild - else - FWindowType := wtWindow; - - FCanvas := TfpgCanvas.Create(self); -end; - -destructor TfpgWindow.Destroy; -begin - FCanvas.Free; - inherited Destroy; -end; - -procedure TfpgWindow.SetParent(const AValue: TfpgWindow); -begin - inherited SetParent(AValue); -end; - -function TfpgWindow.GetParent: TfpgWindow; -begin - result := TfpgWindow(inherited GetParent); -end; - -function TfpgWindow.GetCanvas: TfpgCanvas; -begin - Result := TfpgCanvas(inherited GetCanvas); -end; - - -{ TfpgStyle } - -constructor TfpgStyle.Create; -begin - // Setup font aliases - fpgSetNamedFont('Label1', 'Arial-10'); - fpgSetNamedFont('Label2', 'Arial-10:bold'); - fpgSetNamedFont('Edit1', 'Arial-10'); - fpgSetNamedFont('Edit2', 'Courier New-10'); - fpgSetNamedFont('List', 'Arial-10'); - fpgSetNamedFont('Grid', 'Arial-9:antialias=false'); - fpgSetNamedFont('GridHeader', 'Arial-9:bold:antialias=false'); - fpgSetNamedFont('Menu', 'Arial-10'); - fpgSetNamedFont('MenuAccel', 'Arial-10:bold'); - fpgSetNamedFont('MenuDisabled', 'Arial-10:italic'); - - {$Note Refactor this so under Windows it can detect the system colors instead.} - fpgSetNamedColor(clWindowBackground, $D4D0C8); - fpgSetNamedColor(clBoxColor, $FFFFFF); - fpgSetNamedColor(clShadow1, $808080); - fpgSetNamedColor(clShadow2, $404040); - fpgSetNamedColor(clHilite1, $E0E0E0); - fpgSetNamedColor(clHilite2, $FFFFFF); - fpgSetNamedColor(clText1, $000000); - fpgSetNamedColor(clText2, $000040); - fpgSetNamedColor(clText3, $800000); - fpgSetNamedColor(clText4, $404000); - fpgSetNamedColor(clSelection, $000080); - fpgSetNamedColor(clSelectionText, $FFFFFF); - fpgSetNamedColor(clInactiveSel, $D0D0FF); - fpgSetNamedColor(clInactiveSelText, $000000); - fpgSetNamedColor(clScrollBar, $E8E4DB); - fpgSetNamedColor(clButtonFace, $D4D0C8); - fpgSetNamedColor(clListBox, $FFFFFF); - fpgSetNamedColor(clGridLines, $A0A0A0); - fpgSetNamedColor(clGridHeader, $E0E0E0); - fpgSetNamedColor(clWidgetFrame, $000000); - fpgSetNamedColor(clInactiveWgFrame, $A0A0A0); - fpgSetNamedColor(clTextCursor, $000000); - fpgSetNamedColor(clChoiceListBox, $E8E8E8); - fpgSetNamedColor(clUnset, $D0D0FF); - fpgSetNamedColor(clMenuText, $000000); - fpgSetNamedColor(clMenuDisabled, $909090); - - // Global Font Objects - DefaultFont := fpgGetFont(fpgGetNamedFontDesc('Label1')); - MenuFont := fpgGetFont(fpgGetNamedFontDesc('Menu')); - MenuAccelFont := fpgGetFont(fpgGetNamedFontDesc('MenuAccel')); - MenuDisabledFont := fpgGetFont(fpgGetNamedFontDesc('MenuDisabled')); -end; - -procedure TfpgStyle.DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags); -begin - ACanvas.SetColor(clButtonFace); - ACanvas.SetLineStyle(1, lsSolid); - ACanvas.FillRectangle(x, y, w, h); - - // Left and Top (outer) - if (btnIsPressed in AFlags) then - begin - if (btnIsEmbedded in AFlags) then - ACanvas.SetColor(clHilite1) - else - ACanvas.SetColor(clShadow2); - end - else - ACanvas.SetColor(clHilite1); - ACanvas.DrawLine(x, y+h-1, x, y); // left - ACanvas.DrawLine(x, y, x+w, y); // top - - // Left and Top (inner) - //if btnIsPressed in AFlags then - //begin - //ACanvas.SetColor(clShadow1); - //ACanvas.DrawLine(x + 1, y + h - 3, x + 1, y + 1); // left - //ACanvas.DrawLine(x + 1, y + 1, x + w - 2, y + 1); // top - //end; - - // Right and Bottom (outer) - if (btnIsPressed in AFlags) then - begin - if (btnIsEmbedded in AFlags) then - ACanvas.SetColor(clHilite1) - else - ACanvas.SetColor(clShadow2); - end - else - begin - if (btnIsDefault in AFlags) then - ACanvas.SetColor(clBlack) - else - ACanvas.SetColor(clShadow2); - end; - ACanvas.DrawLine(x+w-1, y, x+w-1, y+h-1); // right - ACanvas.DrawLine(x, y+h-1, x+w, y+h-1); // bottom - - // Right and Bottom (inner) - if btnIsPressed in AFlags then - begin - if (btnIsEmbedded in AFlags) then - ACanvas.SetColor(clButtonFace) - else - ACanvas.SetColor(clHilite1); - end - else - begin - if (btnIsDefault in AFlags) then - ACanvas.SetColor(clShadow2) - else - ACanvas.SetColor(clShadow1); - end; - ACanvas.DrawLine(x+w-2, y+1, x+w-2, y+h-2); // right - ACanvas.DrawLine(x+1, y+h-2, x+w-1, y+h-2); // bottom -end; - -procedure TfpgStyle.DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); -begin - ACanvas.SetColor(clShadow1); - ACanvas.DrawLine(x, y, x + w - 1, y); - ACanvas.DrawLine(x, y + h - 1, x, y); - - ACanvas.SetColor(clShadow2); - ACanvas.DrawLine(x + 1, y + 1, x + w - 2, y + 1); - ACanvas.DrawLine(x + 1, y + h - 2, x + 1, y + 1); - - ACanvas.SetColor(clHilite2); - ACanvas.DrawLine(x + 1, y + h - 1, x + w - 1, y + h - 1); - ACanvas.DrawLine(x + w - 1, y + 1, x + w - 1, y + h - 1); - - ACanvas.SetColor(clHilite1); - ACanvas.DrawLine(x + 2, y + h - 2, x + w - 2, y + h - 2); - ACanvas.DrawLine(x + w - 2, y + 2, x + w - 2, y + h - 2); -end; - -procedure TfpgStyle.DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: integer); -var - peekx: TfpgCoord; - peeky: TfpgCoord; - basex: TfpgCoord; - basey: TfpgCoord; - side: TfpgCoord; - margin: TfpgCoord; -begin - ACanvas.SetColor(clText1); - side := (w div 4) + 1; - margin := side + 1; - - if direction < 2 then // vertical - begin - peekx := x + (w div 2); - if direction = 1 then // down - begin - peeky := y + h - margin; - basey := peeky - side; - end - else - begin // up - peeky := y + margin; - basey := peeky + side; - end; - ACanvas.FillTriangle(peekx, peeky, peekx + side, basey, peekx - side, basey); - end - else // horizontal - begin - peeky := y + (h div 2); - if direction = 3 then // right - begin - peekx := x + w - margin; - basex := peekx - side; - end - else // left - begin - peekx := x + margin; - basex := peekx + side; - end; - ACanvas.FillTriangle(peekx, peeky, basex, peeky - side, basex, peeky + side); - end; -end; - -{ TfpgCaret } - -procedure TfpgCaret.OnTimerTime(Sender: TObject); -begin - if FEnabled then - InvertCaret; -end; - -constructor TfpgCaret.Create; -begin - FEnabled := False; - FInterval := 500; // blinking interval - FCanvas := nil; - FTop := 0; - FLeft := 0; - FWidth := 1; - FHeight := 8; - FTimer := TfpgTimer.Create(FInterval); - FTimer.OnTimer := @OnTimerTime; - FTimer.Enabled := True; -end; - -destructor TfpgCaret.Destroy; -begin - FTimer.Free; - inherited Destroy; -end; - -procedure TfpgCaret.SetCaret(acanvas: TfpgCanvas; x, y, w, h: TfpgCoord); -begin - FEnabled := True; - FVisible := False; - FCanvas := acanvas; - FLeft := x; - FTop := y; - FWidth := w; - FHeight := h; - InvertCaret; - - FTimer.Enabled := False; - FTimer.Interval := FInterval; - FTimer.Enabled := True; -end; - -procedure TfpgCaret.UnSetCaret(acanvas: TfpgCanvas); -begin - if (FCanvas = acanvas) or (acanvas = nil) then - begin - FEnabled := False; - FCanvas := nil; - end; -end; - -procedure TfpgCaret.InvertCaret; -begin - if FCanvas = nil then - Exit; //==> - - // we could not be sure about the buffer contents! - FCanvas.BeginDraw(False); - try - // this works well on narrow characters like 'i' or 'l' in non-mono fonts - FCanvas.XORFillRectangle($FFFFFF, FLeft, FTop, FWidth, FHeight); - FVisible := not FVisible; - finally - FCanvas.EndDraw(FLeft, FTop, FWidth, FHeight); - end; -end; - -{ TfpgImages } - -constructor TfpgImages.Create; -begin - FImages := TStringList.Create; -end; - -destructor TfpgImages.Destroy; -var - n: integer; -begin - for n := 0 to FImages.Count - 1 do - FImages.Objects[n].Free; - FImages.Free; - inherited Destroy; -end; - -function TfpgImages.AddImage(const imgid: string; img: TfpgImage): boolean; -var - i: integer; -begin - i := FImages.IndexOf(LowerCase(imgid)); - if i >= 0 then - begin - FImages.Strings[i] := LowerCase(imgid); - FImages.Objects[i] := img; - Result := False; - end - else - begin - FImages.AddObject(LowerCase(imgid), img); - Result := True; - end; -end; - -function TfpgImages.DeleteImage(const imgid: string; freeimg: boolean): boolean; -var - i: integer; - img: TfpgImage; -begin - i := FImages.IndexOf(LowerCase(imgid)); - if i >= 0 then - begin - if freeimg then - TfpgImage(FImages.Objects[i]).Free; - FImages.Delete(i); - Result := True; - end - else - Result := False; -end; - -function TfpgImages.GetImage(const imgid: string): TfpgImage; -var - i: integer; -begin - i := FImages.IndexOf(LowerCase(imgid)); - if i >= 0 then - Result := TfpgImage(FImages.Objects[i]) - else - Result := nil; -end; - -function TfpgImages.AddBMP(const imgid: string; bmpdata: pointer; bmpsize: integer): TfpgImage; -begin - Result := CreateImage_BMP(bmpdata, bmpsize); - if Result <> nil then - AddImage(imgid, Result); -end; - -function TfpgImages.AddMaskedBMP(const imgid: string; bmpdata: pointer; bmpsize: integer; - mcx, mcy: integer): TfpgImage; -begin - Result := AddBMP(imgid, bmpdata, bmpsize); - if Result <> nil then - begin - Result.CreateMaskFromSample(mcx, mcy); - Result.UpdateImage; - end; -end; - -procedure TfpgImages.ListImages(var sl: TStringList); -begin - if sl <> nil then - sl.Assign(FImages); -end; - - -{ TfpgImage } - -function TfpgImage.ImageFromRect(var ARect: TRect): TfpgImage; -var - x, y: TfpgCoord; - ix, iy: TfpgCoord; -begin - SortRect(ARect); - - Result := TfpgImage.Create; - Result.AllocateImage(ColorDepth, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top); - Result.UpdateImage; - - iy := -1; - for y := ARect.Top to ARect.Bottom-1 do - begin - Inc(iy); - ix := -1; - for x := ARect.Left to ARect.Right-1 do - begin - Inc(ix); - Result.Colors[ix, iy] := Colors[x, y]; - end; - end; -end; - -initialization - uApplication := nil; - fpgTimers := nil; - fpgCaret := nil; - fpgImages := nil; - fpgInitMsgQueue; - -finalization; - fpgCaret.Free; - uApplication.free; - -end. - diff --git a/prototypes/fpgui2/source/core/gdi/fpGFX2.lpk b/prototypes/fpgui2/source/core/gdi/fpGFX2.lpk deleted file mode 100644 index 4e261b61..00000000 --- a/prototypes/fpgui2/source/core/gdi/fpGFX2.lpk +++ /dev/null @@ -1,120 +0,0 @@ -<?xml version="1.0"?>
-<CONFIG>
- <Package Version="2">
- <PathDelim Value="\"/>
- <Name Value="fpGFX2"/>
- <Author Value="Graeme Geldenhuys"/>
- <CompilerOptions>
- <Version Value="5"/>
- <PathDelim Value="\"/>
- <SearchPaths>
- <IncludeFiles Value="..\..\"/>
- <OtherUnitFiles Value="..\;..\..\gui\"/>
- <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
- </SearchPaths>
- <CodeGeneration>
- <Generate Value="Faster"/>
- </CodeGeneration>
- <Other>
- <CompilerPath Value="$(CompPath)"/>
- </Other>
- </CompilerOptions>
- <Description Value="fpGFX redesign with multiple handles per window
-"/>
- <License Value="Modified LGPL
-"/>
- <Version Minor="1"/>
- <Files Count="19">
- <Item1>
- <Filename Value="..\gfxbase.pas"/>
- <UnitName Value="gfxbase"/>
- </Item1>
- <Item2>
- <Filename Value="..\gfxbaseinterfaces.pas"/>
- <UnitName Value="gfxbaseinterfaces"/>
- </Item2>
- <Item3>
- <Filename Value="..\fpgfx.pas"/>
- <UnitName Value="fpgfx"/>
- </Item3>
- <Item4>
- <Filename Value="gfx_gdi.pas"/>
- <UnitName Value="gfx_gdi"/>
- </Item4>
- <Item5>
- <Filename Value="..\gfx_stdimages.pas"/>
- <UnitName Value="gfx_stdimages"/>
- </Item5>
- <Item6>
- <Filename Value="..\gfx_imgfmt_bmp.pas"/>
- <UnitName Value="gfx_imgfmt_bmp"/>
- </Item6>
- <Item7>
- <Filename Value="..\gfx_widget.pas"/>
- <UnitName Value="gfx_widget"/>
- </Item7>
- <Item8>
- <Filename Value="..\..\gui\gui_form.pas"/>
- <UnitName Value="gui_form"/>
- </Item8>
- <Item9>
- <Filename Value="..\..\gui\gui_label.pas"/>
- <UnitName Value="gui_label"/>
- </Item9>
- <Item10>
- <Filename Value="..\..\gui\gui_button.pas"/>
- <UnitName Value="gui_button"/>
- </Item10>
- <Item11>
- <Filename Value="..\..\gui\gui_edit.pas"/>
- <UnitName Value="gui_edit"/>
- </Item11>
- <Item12>
- <Filename Value="..\..\gui\gui_combobox.pas"/>
- <UnitName Value="gui_combobox"/>
- </Item12>
- <Item13>
- <Filename Value="..\..\gui\gui_popupwindow.pas"/>
- <UnitName Value="gui_popupwindow"/>
- </Item13>
- <Item14>
- <Filename Value="..\..\gui\gui_scrollbar.pas"/>
- <UnitName Value="gui_scrollbar"/>
- </Item14>
- <Item15>
- <Filename Value="..\..\gui\gui_memo.pas"/>
- <UnitName Value="gui_memo"/>
- </Item15>
- <Item16>
- <Filename Value="..\gfx_utf8utils.pas"/>
- <UnitName Value="gfx_UTF8utils"/>
- </Item16>
- <Item17>
- <Filename Value="..\..\gui\gui_dialogs.pas"/>
- <UnitName Value="gui_dialogs"/>
- </Item17>
- <Item18>
- <Filename Value="..\..\gui\gui_listbox.pas"/>
- <UnitName Value="gui_listbox"/>
- </Item18>
- <Item19> - <Filename Value="..\gfx_extinterpolation.pas"/> - <UnitName Value="gfx_extinterpolation"/> - </Item19> - </Files>
- <RequiredPkgs Count="1">
- <Item1>
- <PackageName Value="FCL"/>
- <MinVersion Major="1" Valid="True"/>
- </Item1>
- </RequiredPkgs>
- <UsageOptions>
- <UnitPath Value="$(PkgOutDir)\"/>
- </UsageOptions>
- <PublishOptions>
- <Version Value="2"/>
- <DestinationDirectory Value="$(TestDir)\publishedpackage\"/>
- <IgnoreBinaries Value="False"/>
- </PublishOptions>
- </Package>
-</CONFIG>
diff --git a/prototypes/fpgui2/source/core/gdi/fpGFX2.pas b/prototypes/fpgui2/source/core/gdi/fpGFX2.pas deleted file mode 100644 index 1a748229..00000000 --- a/prototypes/fpgui2/source/core/gdi/fpGFX2.pas +++ /dev/null @@ -1,17 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! -This source is only used to compile and install the package. - } - -unit fpGFX2; - -interface - -uses - gfxbase, gfxbaseinterfaces, fpgfx, gfx_gdi, gfx_stdimages, gfx_imgfmt_bmp, - gfx_widget, gui_form, gui_label, gui_button, gui_edit, gui_combobox, - gui_popupwindow, gui_scrollbar, gui_memo, gfx_UTF8utils, gui_dialogs, - gui_listbox; - -implementation - -end. diff --git a/prototypes/fpgui2/source/core/gdi/gdikeys.inc b/prototypes/fpgui2/source/core/gdi/gdikeys.inc deleted file mode 100644 index 1be7a470..00000000 --- a/prototypes/fpgui2/source/core/gdi/gdikeys.inc +++ /dev/null @@ -1,321 +0,0 @@ -{ - fpGFX - Free Pascal Graphics Library - - Win32 GDI target implementation: Keycode translation helpers - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about the copyright. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - - **********************************************************************} - - -function VirtKeyToKeycode(VirtKey: Byte): Word; -const - TranslTable: array[Byte] of Integer = ( - -1, // $00 - -1, // $01 VK_LBUTTON - -1, // $02 VK_RBUTTON - -1, // $03 VK_CANCEL - -1, // $04 VK_MBUTTON - -1, // $05 VK_XBUTTON1 - -1, // $06 VK_XBUTTON2 - -1, // $07 - keyBackSpace, // $08 VK_BACK - keyTab, // $09 VK_TAB - -1, // $0a - -1, // $0b - keyClear, // $0c VK_CLEAR - keyReturn, // $0d VK_RETURN - -1, // $0e - -1, // $0f - keyShift, // $10 VK_SHIFT - keyCtrl, // $11 VK_CONTROL - keyAlt, // $12 VK_MENU - keyPause, // $13 VK_PAUSE - -1, // $14 VK_CAPITAL - -1, // $15 VK_KANA - -1, // $16 - -1, // $17 VK_JUNJA - -1, // $18 VK_FINAL - -1, // $19 VK_HANJA - -1, // $1a - keyEscape, // $1b VK_ESCAPE - -1, // $1c VK_CONVERT - -1, // $1d VK_NONCONVERT - -1, // $1e VK_ACCEPT - keyModeSwitch, // $1f VK_MODECHANGE - $20, // $20 VK_SPACE - keyPrior, // $21 VK_PRIOR - keyNext, // $22 VK_NEXT - keyEnd, // $23 VK_END - keyHome, // $24 VK_HOME - keyLeft, // $25 VK_LEFT - keyUp, // $26 VK_UP - keyRight, // $27 VK_RIGHT - keyDown, // $28 VK_DOWN - keySelect, // $29 VK_SELECT - keyPrintScreen, // $2a VK_PRINT - keyExecute, // $2b VK_EXECUTE - keyPrintScreen, // $2c VK_SNAPSHOT - keyInsert, // $2d VK_INSERT - keyDelete, // $2e VK_DELETE - keyHelp, // $2f VK_HELP - $30, // $30 '0' - $31, // $31 '1' - $32, // $32 '2' - $33, // $33 '3' - $34, // $34 '4' - $35, // $35 '5' - $36, // $36 '6' - $37, // $37 '7' - $38, // $38 '8' - $39, // $39 '9' - -1, // $3a - -1, // $3b - -1, // $3c - -1, // $3d - -1, // $3e - -1, // $3f - -1, // $40 - $41, // $41 'A' - $42, // $42 'B' - $43, // $43 'C' - $44, // $44 'D' - $45, // $45 'E' - $46, // $46 'F' - $47, // $47 'G' - $48, // $48 'H' - $49, // $49 'I' - $4a, // $4a 'J' - $4b, // $4b 'K' - $4c, // $4c 'L' - $4d, // $4d 'M' - $4e, // $4e 'N' - $4f, // $4f 'O' - $50, // $50 'P' - $51, // $51 'Q' - $52, // $52 'R' - $53, // $53 'S' - $54, // $54 'T' - $55, // $55 'U' - $56, // $56 'V' - $57, // $57 'W' - $58, // $58 'X' - $59, // $59 'Y' - $5a, // $5a 'Z' - -1, // $5b VK_LWIN - -1, // $5c VK_RWIN - -1, // $5d VK_APPS - -1, // $5e - -1, // $5f VK_SLEEP - keyP0, // $60 VK_NUMPAD0 - keyP1, // $61 VK_NUMPAD1 - keyP2, // $62 VK_NUMPAD2 - keyP3, // $63 VK_NUMPAD3 - keyP4, // $64 VK_NUMPAD4 - keyP5, // $65 VK_NUMPAD5 - keyP6, // $66 VK_NUMPAD6 - keyP7, // $67 VK_NUMPAD7 - keyP8, // $68 VK_NUMPAD8 - keyP9, // $69 VK_NUMPAD9 - keyPAsterisk, // $6a VK_MULTIPLY - keyPPlus, // $6b VK_ADD - keyPSeparator, // $6c VK_SEPARATOR - keyPMinus, // $6d VK_SUBTRACT - keyPDecimal, // $6e VK_DECIMAL - keyPSlash, // $6f VK_DIVIDE - keyF1, // $70 VK_F1 - keyF2, // $71 VK_F2 - keyF3, // $72 VK_F3 - keyF4, // $73 VK_F4 - keyF5, // $74 VK_F5 - keyF6, // $75 VK_F6 - keyF7, // $76 VK_F7 - keyF8, // $77 VK_F8 - keyF9, // $78 VK_F9 - keyF10, // $79 VK_F10 - keyF11, // $7a VK_F11 - keyF12, // $7b VK_F12 - keyF13, // $7c VK_F13 - keyF14, // $7d VK_F14 - keyF15, // $7e VK_F15 - keyF16, // $7f VK_F16 - keyF17, // $80 VK_F17 - keyF18, // $81 VK_F18 - keyF19, // $82 VK_F19 - keyF20, // $83 VK_F20 - keyF21, // $84 VK_F21 - keyF22, // $85 VK_F22 - keyF23, // $86 VK_F23 - keyF24, // $87 VK_F24 - -1, // $88 - -1, // $89 - -1, // $8a - -1, // $8b - -1, // $8c - -1, // $8d - -1, // $8e - -1, // $8f - keyNumLock, // $90 VK_NUMLOCK - keyScroll, // $91 VK_SCROLL - -1, // $92 VK_OEM_NEC_EQUAL - -1, // $93 VK_OEM_FJ_MASSHOU - -1, // $94 VK_OEM_FJ_TOUROKU - -1, // $95 VK_OEM_FJ_LOYA - -1, // $96 VK_OEM_FJ_ROYA - -1, // $97 - -1, // $98 - -1, // $99 - -1, // $9a - -1, // $9b - -1, // $9c - -1, // $9d - -1, // $9e - -1, // $9f - keyShiftL, // $a0 VK_LSHIFT - keyShiftR, // $a1 VK_RSHIFT - keyCtrlL, // $a2 VK_LCONTROL - keyCtrlR, // $a3 VK_RCONTROL - -1, // $a4 VK_LMENU - -1, // $a5 VK_RMENU - -1, // $a6 VK_BROWSER_BACK - -1, // $a7 VK_BROWSER_FORWARD - -1, // $a8 VK_BROWSER_REFRESH - -1, // $a9 VK_BROWSER_STOP - -1, // $aa VK_BROWSER_SEARCH - -1, // $ab VK_BROWSER_FAVORITES - -1, // $ac VK_BROWSER_HOME - -1, // $ad VK_VOLUME_MUTE - -1, // $ae VK_VOLUME_DOWN - -1, // $af VK_VOLUME_UP - -1, // $b0 VK_MEDIA_NEXT_TRACK - -1, // $b1 VK_MEDIA_PREV_TRACK - -1, // $b2 VK_MEDIA_STOP - -1, // $b3 VK_MEDIA_PLAY_PAUSE - -1, // $b4 VK_LAUNCH_MAIL - -1, // $b5 VK_LAUNCH_MEDIA_SELECT - -1, // $b6 VK_LAUNCH_APP1 - -1, // $b7 VK_LAUNCH_APP2 - -1, // $b8 - -1, // $b9 - $dc, {U Umlaut} // $ba VK_OEM_1 - $2b, {+ char} // $bb VK_OEM_PLUS - $2c, {, char} // $bc VK_OEM_COMMA - $2d, {- char} // $bd VK_OEM_MINUS - $2e, {. char} // $be VK_OEM_PERIOD - $23, {# char} // $bf VK_OEM_2 - $d6, {O Umlaut} // $c0 VK_OEM_3 - -1, // $c1 - -1, // $c2 - -1, // $c3 - -1, // $c4 - -1, // $c5 - -1, // $c6 - -1, // $c7 - -1, // $c8 - -1, // $c9 - -1, // $ca - -1, // $cb - -1, // $cc - -1, // $cd - -1, // $ce - -1, // $cf - -1, // $d0 - -1, // $d1 - -1, // $d2 - -1, // $d3 - -1, // $d4 - -1, // $d5 - -1, // $d6 - -1, // $d7 - -1, // $d8 - -1, // $d9 - -1, // $da - -1, // $db VK_OEM_4 - keyDeadCircumflex, // $dc VK_OEM_5 - keyDeadAcute, // $dd VK_OEM_6 - $c4, {A Umlaut} // $de VK_OEM_7 - -1, // $df VK_OEM_8 - -1, // $e0 - -1, // $e1 VK_OEM_AX - $3c, {< char} // $e2 VK_OEM_102 - -1, // $e3 VK_ICO_HELP - keyP5, // $e4 VK_ICO_00 - -1, // $e5 VK_PROCESSKEY - -1, // $e6 VK_ICO_CLEAR - -1, // $e7 VK_PACKET - -1, // $e8 - -1, // $e9 VK_OEM_RESET - -1, // $ea VK_OEM_JUMP - -1, // $eb VK_OEM_PA1 - -1, // $ec VK_OEM_PA2 - -1, // $ed VK_OEM_PA3 - -1, // $ee VK_OEM_WSCTRL - -1, // $ef VK_OEM_CUSEL - -1, // $f0 VK_OEM_ATTN - -1, // $f1 VK_OEM_FINISH - -1, // $f2 VK_OEM_COPY - -1, // $f3 VK_OEM_AUTO - -1, // $f4 VK_OEM_ENLW - -1, // $f5 VK_OEM_BACKTAB - -1, // $f6 VK_ATTN - -1, // $f7 VK_CRSEL - -1, // $f8 VK_EXSEL - -1, // $f9 VK_EREOF - -1, // $fa VK_PLAY - -1, // $fb VK_ZOOM - -1, // $fc VK_NONAME - -1, // $fd VK_PA1 - -1, // $fe VK_OEM_CLEAR - -1 // $ff - ); -begin - if TranslTable[VirtKey] = -1 then - begin -{$IFDEF Debug} - WriteLn('No mapping for virtual keycode $', IntToHex(VirtKey, 2)); -{$ENDIF} - Result := keyNIL - end else - begin - Result := TranslTable[VirtKey]; -{$IFDEF Debug} - WriteLn('Key $', IntToHex(VirtKey, 2), ' mapped to $', IntToHex(Result, 4)); -{$ENDIF} - end; -end; - - -function GetKeyboardShiftState: TShiftState; -var - State: array[Byte] of Byte; -begin - {$ifndef wince} - Windows.GetKeyboardState(State); - {$endif} - Result := []; - if (State[VK_SHIFT] and 128) <> 0 then - Include(Result, ssShift); - if (State[VK_MENU] and 128) <> 0 then - Include(Result, ssAlt); - if (State[VK_CONTROL] and 128) <> 0 then - Include(Result, ssCtrl); - if (State[VK_LBUTTON] and 128) <> 0 then - Include(Result, ssLeft); - if (State[VK_RBUTTON] and 128) <> 0 then - Include(Result, ssRight); - if (State[VK_MBUTTON] and 128) <> 0 then - Include(Result, ssMiddle); - if (State[VK_CAPITAL] and 1) <> 0 then - Include(Result, ssCaps); - if (State[VK_NUMLOCK] and 1) <> 0 then - Include(Result, ssNum); - if (State[VK_SCROLL] and 1) <> 0 then - Include(Result, ssScroll); -end; - - diff --git a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas deleted file mode 100644 index a30f343c..00000000 --- a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas +++ /dev/null @@ -1,1520 +0,0 @@ -unit gfx_gdi; - -{$mode objfpc}{$H+} - -{.$Define Debug} - -interface - -uses - Classes, - SysUtils, - Windows, - gfxbase; - -{ Constants missing on windows unit } -const - WM_MOUSEWHEEL = $020a; - VER_PLATFORM_WIN32_CE = 3; - -{ Unicode selection variables } -var - UnicodeEnabledOS: Boolean; - WinVersion: TOSVersionInfo; - - -type - TfpgWinHandle = HWND; - TfpgGContext = HDC; - -type - TfpgWindowImpl = class; - - - TfpgFontResourceImpl = class(TfpgFontResourceBase) - private - FFontData: HFONT; - FMetrics: Windows.TEXTMETRIC; - protected - function OpenFontByDesc(const desc: string): HFONT; - property Handle: HFONT read FFontData; - public - constructor Create(const afontdesc: string); - destructor Destroy; override; - function HandleIsValid: boolean; - function GetAscent: integer; override; - function GetDescent: integer; override; - function GetHeight: integer; override; - function GetTextWidth(const txt: string): integer; override; - end; - - - TfpgFontImpl = class(TfpgFontBase) - end; - - - TfpgImageImpl = class(TfpgImageBase) - private - FBMPHandle: HBITMAP; - FMaskHandle: HBITMAP; - FIsTwoColor: boolean; - property BMPHandle: HBITMAP read FBMPHandle; - property MaskHandle: HBITMAP read FMaskHandle; - protected - procedure DoFreeImage; override; - procedure DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); override; - procedure DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); override; - public - constructor Create; - end; - - - TfpgCanvasImpl = class(TfpgCanvasBase) - private - FDrawing: boolean; - FBufferBitmap: HBitmap; - FDrawWindow: TfpgWindowImpl; - Fgc: TfpgGContext; - FWinGC: TfpgGContext; - FBackgroundColor: TfpgColor; - FCurFontRes: TfpgFontResourceImpl; - FClipRect: TfpgRect; - FClipRectSet: Boolean; - FWindowsColor: longword; - FBrush: HBRUSH; - FPen: HPEN; - FClipRegion: HRGN; - FIntLineStyle: integer; - protected - procedure DoSetFontRes(fntres: TfpgFontResourceBase); override; - procedure DoSetTextColor(cl: TfpgColor); override; - procedure DoSetColor(cl: TfpgColor); override; - procedure DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); override; - procedure DoGetWinRect(var r: TfpgRect); override; - procedure DoFillRectangle(x, y, w, h: TfpgCoord); override; - procedure DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); override; - procedure DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); override; - procedure DoDrawRectangle(x, y, w, h: TfpgCoord); override; - procedure DoDrawLine(x1, y1, x2, y2: TfpgCoord); override; - procedure DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); override; - procedure DoDrawString(x, y: TfpgCoord; const txt: string); override; - procedure DoSetClipRect(const rect: TfpgRect); override; - function DoGetClipRect: TfpgRect; override; - procedure DoAddClipRect(const rect: TfpgRect); override; - procedure DoClearClipRect; override; - procedure DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); override; - procedure DoPutBufferToScreen(x, y, w, h: TfpgCoord); override; - procedure DoEndDraw; override; - function GetPixel(X, Y: integer): TfpgColor; override; - procedure SetPixel(X, Y: integer; const AValue: TfpgColor); override; - public - constructor Create; override; - destructor Destroy; override; - end; - - - { TfpgWindowImpl } - - TfpgWindowImpl = class(TfpgWindowBase) - private - FMouseInWindow: boolean; - function DoMouseEnterLeaveCheck(AWindow: TfpgWindowImpl; uMsg, wParam, lParam: Cardinal): Boolean; - protected - FWinHandle: TfpgWinHandle; - FModalForWin: TfpgWindowImpl; - FWinStyle: longword; - FWinStyleEx: longword; - FParentWinHandle: TfpgWinHandle; - procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override; - procedure DoReleaseWindowHandle; override; - function HandleIsValid: boolean; override; - procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); override; - procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); override; - function DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; override; - //procedure MoveToScreenCenter; override; - procedure DoSetWindowTitle(const ATitle: string); override; - property WinHandle: TfpgWinHandle read FWinHandle; - public - constructor Create(AOwner: TComponent); override; - procedure CaptureMouse; override; - procedure ReleaseMouse; override; - end; - - - TfpgApplicationImpl = class(TfpgApplicationBase) - protected - FDisplay: HDC; - WindowClass: TWndClass; - WidgetClass: TWndClass; - hcr_default: HCURSOR; - hcr_dir_ew: HCURSOR; - hcr_dir_ns: HCURSOR; - hcr_edit: HCURSOR; - hcr_dir_nwse: HCURSOR; - hcr_dir_nesw: HCURSOR; - hcr_move: HCURSOR; - hcr_crosshair: HCURSOR; - FFocusedWindow: THANDLE; - LastClickWindow: TfpgWinHandle; // double click generation - LastWinClickTime: longword; - FTimerWnd: HWND; - public - constructor Create(const aparams: string); override; - function DoMessagesPending: boolean; - procedure DoWaitWindowMessage(atimeoutms: integer); - procedure DoFlush; - function GetScreenWidth: TfpgCoord; - function GetScreenHeight: TfpgCoord; - property Display: HDC read FDisplay; - end; - - -implementation - -uses - {$Note Remove the dependency on gfx_widget and gfx_form units.} - fpgfx, - gfx_widget,//, gfx_form; - gfx_UTF8Utils; - -var - wapplication: TfpgApplication; - MouseFocusedWH: HWND; - -// some required keyboard functions -{$INCLUDE gdikeys.inc} - -function fpgColorToWin(col: TfpgColor): longword; -var - c: dword; -begin - c := fpgColorToRGB(col); - //swapping bytes (Red and Blue colors) - Result := ((c and $FF0000) shr 16) or ((c and $0000FF) shl 16) or (c and $00FF00); -end; - -function WinColorTofpgColor(col: longword): TfpgColor; -begin - //swapping bytes - Result := fpgColorToWin(col); -end; - -function GetMyWidgetFromHandle(wh: TfpgWinHandle): TfpgWidget; -begin - if (wh <> 0) and (MainInstance = longword(GetWindowLong(wh, GWL_HINSTANCE))) then - Result := TfpgWidget(Windows.GetWindowLong(wh, GWL_USERDATA)) - else - Result := nil; -end; - -(* -procedure SendMouseMessage(wg : TWidget; msg : UINT; button : integer; wParam : WPARAM; lParam : LPARAM); -var - p3 : integer; - x,y : integer; - wwg : TWidget; - pwg : TWidget; - h : THANDLE; - pt : TPOINT; -begin - x := SmallInt(lParam and $FFFF); - y := SmallInt((lParam and $FFFF0000) shr 16); - - p3 := button shl 8; - - if (wParam and MK_CONTROL) <> 0 then p3 := p3 or ss_control; - if (wParam and MK_SHIFT) <> 0 then p3 := p3 or ss_shift; - - - wwg := wg; - - if (PopupListFirst <> nil) then - begin - if wg = nil then Writeln('wg is NIL !!!'); - - pt.x := x; - pt.y := y; - - ClientToScreen(wg.WinHandle, pt); - - //Writeln('click x=',pt.X,' y=',pt.y); - - h := WindowFromPoint(pt); - wwg := GetMyWidgetFromHandle(h); - - // if wwg <> nil then writeln('widget ok.'); - - pwg := wwg; - while (pwg <> nil) and (pwg.Parent <> nil) do pwg := pwg.Parent; - - if ((pwg = nil) or (PopupListFind(pwg.WinHandle) = nil)) and (not PopupDontCloseWidget(wwg)) and - ((msg = MSG_MOUSEDOWN) or (msg = MSG_MOUSEUP)) then - begin - ClosePopups; - - SendMessage(nil, wwg, MSG_POPUPCLOSE, 0, 0, 0 ); - end; - - // sending the message... - if wwg <> nil then - begin - ScreenToClient(wwg.WinHandle, pt); - x := pt.x; - y := pt.y; - end; - end; - - if ptkTopModalForm <> nil then - begin - pwg := WidgetParentForm(wwg); - if (pwg <> nil) and (ptkTopModalForm <> pwg) then wwg := nil; - end; - - if wwg <> nil then - begin - if (Msg = MSG_MOUSEDOWN) and (PopupListFirst = nil) then - begin - SetCapture(wwg.WinHandle); - end - else if (Msg = MSG_MOUSEUP) and (PopupListFirst = nil) then - begin - ReleaseCapture(); - end; - - SendMessage(nil, wwg, Msg, x, y, p3); - - end; - -end; - -*) - -function fpgWindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; -var - w: TfpgWindowImpl; - kwg: TfpgWidget; - mw: TfpgWindowImpl; - kcode: integer; - i: integer; - sstate: integer; - h: THANDLE; - p: PChar; - pt: TPOINT; - r: TRECT; - blockmsg: boolean; - msgp: TfpgMessageParams; - mcode: integer; - wmsg: TMsg; - PaintStruct: TPaintStruct; -begin - if uMsg = WM_CREATE then - begin - w := TfpgWindowImpl(PCreateStruct(lParam)^.lpCreateParams); - w.FWinHandle := hwnd; // this is very important, because number of messages sent - // before the createwindow returns the window handle - Windows.SetWindowLong(hwnd, GWL_USERDATA, longword(w)); - end; - - w := TfpgWindowImpl(Windows.GetWindowLong(hwnd, GWL_USERDATA)); - Result := 0; - - if not Assigned(w) then - begin - Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam); - Exit; - end; - - blockmsg := False; - fillchar(msgp, sizeof(msgp), 0); - - case uMsg of - WM_CHAR, - WM_KEYUP, - WM_KEYDOWN: - begin - kwg := FindKeyboardFocus; - if kwg <> nil then - w := kwg; - - msgp.keyboard.shiftstate := GetKeyboardShiftState; - msgp.keyboard.keycode := VirtKeyToKeycode(wParam); - - if uMsg = WM_KEYDOWN then - begin - fpgSendMessage(nil, w, FPGM_KEYPRESS, msgp); - - // generating WM_CHAR - fillchar(wmsg, sizeof(wmsg), 0); - - wmsg.hwnd := hwnd; - wmsg.message := uMsg; - wmsg.wParam := wParam; - wmsg.lParam := lParam; - - Windows.TranslateMessage(@wmsg); - - // TranslateMessage sends WM_CHAR ocassionally - // but NOBODY KNOWS WHEN! - - - if (wParam = $2e {VK_DELETE}) then - begin - msgp.keyboard.keychar := #127; - msgp.keyboard.keycode := 0; - fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp); - end; - - // lets generate the FPGM_KEYCHAR for some special keys - // based on this table of Windows virtual keys -// case wParam of -// $70..$7B, // F1..F12 -// $21..$24, // home, end, pageup, pagedn -// $2D..$2E, // insert, delete -// $25..$28: // arrows -// begin -// msgp.keyboard.keycode := kcode or $FF00; // scan code + $FF00 -// fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp); -// end; -// end; - - end - else if uMsg = WM_KEYUP then - fpgSendMessage(nil, w, FPGM_KEYRELEASE, msgp) - else if uMsg = WM_CHAR then - begin - msgp.keyboard.keychar := Chr(wParam); - fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp); - end; - - end; - -(* - WM_SETCURSOR: - begin - //Writeln('Hittest: ',IntToHex((lParam and $FFFF),4)); - if (lParam and $FFFF) <= 1 then - begin - ptkSetMouseCursor(wg.WinHandle, wg.MouseCursor); - result := 1; - end - else Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam); - end; -*) - - WM_MOUSEMOVE, - WM_LBUTTONDOWN, - WM_LBUTTONUP, - WM_LBUTTONDBLCLK, - WM_RBUTTONDOWN, - WM_RBUTTONUP: - begin - msgp.mouse.x := smallint(lParam and $FFFF); - msgp.mouse.y := smallint((lParam and $FFFF0000) shr 16); - - case uMsg of - WM_MOUSEMOVE: - mcode := FPGM_MOUSEMOVE; - WM_LBUTTONDOWN, - WM_RBUTTONDOWN: - mcode := FPGM_MOUSEDOWN; - WM_LBUTTONUP, - WM_RBUTTONUP: - mcode := FPGM_MOUSEUP; - WM_LBUTTONDBLCLK: - mcode := FPGM_DOUBLECLICK; - else - mcode := 0; - end; - - case uMsg of - WM_MOUSEMOVE: - begin - i := 0; - if (wParam and MK_LBUTTON) <> 0 then - i := i or MOUSE_LEFT; - if (wParam and MK_RBUTTON) <> 0 then - i := i or MOUSE_RIGHT; - if (wParam and MK_MBUTTON) <> 0 then - i := i or MOUSE_MIDDLE; - msgp.mouse.Buttons := i; - end; - - WM_LBUTTONDOWN, - WM_LBUTTONUP, - WM_LBUTTONDBLCLK: - msgp.mouse.Buttons := MOUSE_LEFT; - - WM_RBUTTONDOWN, - WM_RBUTTONUP: - msgp.mouse.Buttons := MOUSE_RIGHT; - end; - - msgp.mouse.shiftstate := GetKeyboardShiftState; - - if uMsg = WM_MouseMove then - w.DoMouseEnterLeaveCheck(w, uMsg, wParam, lParam); - - if mcode <> 0 then - fpgSendMessage(nil, w, mcode, msgp); - end; - - WM_SIZE: - begin - // note that WM_SIZING allows some control on sizeing - - //writeln('WM_SIZE: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8)); - - msgp.rect.Width := smallint(lParam and $FFFF); - msgp.rect.Height := smallint((lParam and $FFFF0000) shr 16); - - //writeln('WM_SIZE: width=',msgp.rect.width, ' height=',msgp.rect.height); - - // skip minimize... - if lparam <> 0 then - fpgSendMessage(nil, w, FPGM_RESIZE, msgp); - end; - - - WM_MOVE: - begin - // window decoration correction ... - if (GetWindowLong(w.WinHandle, GWL_STYLE) and WS_CHILD) = 0 then - begin - GetWindowRect(w.WinHandle, r); - msgp.rect.Left := r.Left; - msgp.rect.top := r.Top; - end - else - begin - msgp.rect.Left := smallint(lParam and $FFFF); - msgp.rect.Top := smallint((lParam and $FFFF0000) shr 16); - end; - - fpgSendMessage(nil, w, FPGM_MOVE, msgp); - end; - - WM_MOUSEWHEEL: - begin - //writeln('MWHEEL: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8)); // and $FF00) shr 8); - pt.x := LoWord(lparam); - pt.y := HiWord(lparam); - mw := nil; - h := WindowFromPoint(pt); - if h > 0 then // get window mouse is hovering over - mw := TfpgWindowImpl(Windows.GetWindowLong(h, GWL_USERDATA)); - - if mw <> nil then - begin - msgp.mouse.x := pt.x; - msgp.mouse.y := pt.y; - msgp.mouse.delta := SmallInt(HiWord(wParam)) div -120; - - i := 0; - if (wParam and MK_LBUTTON) <> 0 then - i := i or MOUSE_LEFT; - if (wParam and MK_RBUTTON) <> 0 then - i := i or MOUSE_RIGHT; - if (wParam and MK_MBUTTON) <> 0 then - i := i or MOUSE_MIDDLE; - msgp.mouse.Buttons := i; - msgp.mouse.shiftstate := GetKeyboardShiftState; - - fpgSendMessage(nil, mw, FPGM_SCROLL, msgp) - end; - end; - - WM_ACTIVATE: - if ((wParam and $FFFF) = WA_INACTIVE) then - fpgSendMessage(nil, w, FPGM_DEACTIVATE) - else - fpgSendMessage(nil, w, FPGM_ACTIVATE); - - WM_TIMER: - Result := 0; - //Writeln('TIMER EVENT!!!'); - // used for event wait timeout - - - (* - WM_NCACTIVATE: - begin - if (ptkTopModalForm <> nil) then - begin - if (wParam = 0) and (ptkTopModalForm = wg) then - begin - blockmsg := true; - end - else if (wParam <> 0) and (ptkTopModalForm <> wg) then - begin - blockmsg := true; - end; - end; - - if (PopupListFirst <> nil) and (PopupListFirst.Visible) then BlockMsg := True; - - //writeln('ncactivate: ', ord(BlockMsg)); - - if not BlockMsg then - Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam); - - end; -*) - - WM_CLOSE: - fpgSendMessage(nil, w, FPGM_CLOSE, msgp); - - WM_PAINT: - begin - Windows.BeginPaint(w.WinHandle, @PaintStruct); - fpgSendMessage(nil, w, FPGM_PAINT, msgp); - Windows.EndPaint(w.WinHandle, @PaintStruct); - end; - - else - Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam); - end; -end; - -{ TfpgApplicationImpl } - -constructor TfpgApplicationImpl.Create(const aparams: string); -begin - FIsInitialized := False; - FDisplay := Windows.GetDC(0); - - with WindowClass do - begin - style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC or CS_DBLCLKS; - lpfnWndProc := WndProc(@fpgWindowProc); - hInstance := MainInstance; - hIcon := LoadIcon(0, IDI_APPLICATION); - hCursor := LoadCursor(0, IDC_ARROW); - hbrBackground := 0; //COLOR_WINDOW; - lpszClassName := 'FPGWIN'; - end; - Windows.RegisterClass(@WindowClass); - - with WidgetClass do - begin - style := CS_OWNDC or CS_DBLCLKS; - lpfnWndProc := WndProc(@fpgWindowProc); - hInstance := MainInstance; - hIcon := 0; - hCursor := 0; - hbrBackground := 0; //COLOR_BACKGROUND; - lpszClassName := 'FPGWIDGET'; - end; - Windows.RegisterClass(@WidgetClass); - - hcr_default := LoadCursor(0, IDC_ARROW); - hcr_dir_ew := LoadCursor(0, IDC_SIZEWE); - hcr_dir_ns := LoadCursor(0, IDC_SIZENS); - hcr_edit := LoadCursor(0, IDC_IBEAM); - hcr_dir_nwse := LoadCursor(0, IDC_SIZENWSE); - hcr_DIR_NESW := LoadCursor(0, IDC_SIZENESW); - hcr_MOVE := LoadCursor(0, IDC_SIZEALL); - hcr_CROSSHAIR := LoadCursor(0, IDC_CROSS); - - FIsInitialized := True; - wapplication := TfpgApplication(self); -end; - -function TfpgApplicationImpl.DoMessagesPending: boolean; -var - Msg: TMsg; -begin - Result := Windows.PeekMessageW(@Msg, 0, 0, 0, PM_NOREMOVE); -end; - -procedure TfpgApplicationImpl.DoWaitWindowMessage(atimeoutms: integer); -var - Msg: TMsg; - timerid: longword; - timerwnd: HWND; - mp: boolean; -begin - timerid := 0; - timerwnd := 0; - - if (atimeoutms >= 0) and (not DoMessagesPending) then - if atimeoutms > 0 then - timerid := Windows.SetTimer(timerwnd, 1, atimeoutms, nil) - {$Note This needs to be enabled again, but find a butter solution.} - // timerwnd := fpgMainForm.WinHandle; - else - Exit; // handling waiting timeout - - {$Note Incorporate Felipe's code from previous fpGUI in here. It handles WinCE and Windows just fine. } - if (GetVersion() < $80000000) then - Windows.GetMessageW(@Msg, 0, 0, 0) //NT - else - Windows.GetMessage(@Msg, 0, 0, 0); //Win98 - - Windows.DispatchMessage(@msg); - - if timerid > 0 then - Windows.KillTimer(timerwnd, 1); -end; - -procedure TfpgApplicationImpl.DoFlush; -begin - GdiFlush; -end; - -function TfpgApplicationImpl.GetScreenWidth: TfpgCoord; -var - r: TRECT; -begin - GetWindowRect(GetDesktopWindow, r); - Result := r.Right - r.Left; -end; - -function TfpgApplicationImpl.GetScreenHeight: TfpgCoord; -var - r: TRECT; -begin - GetWindowRect(GetDesktopWindow, r); - Result := r.Bottom - r.Top; -end; - -{ TfpgWindowImpl } - -function TfpgWindowImpl.DoMouseEnterLeaveCheck(AWindow: TfpgWindowImpl; uMsg, wParam, lParam: Cardinal): Boolean; - - //---------------------- - function CursorInDifferentWindow: Boolean; - var - pt: Windows.POINT; - begin - pt.x := LoWord(lParam); - pt.y := HiWord(lParam); - - // only WM_MOUSEWHEEL uses screen coordinates!!! - if uMsg <> WM_MOUSEWHEEL then - Windows.ClientToScreen(FWinHandle, @pt); - - Result := WindowFromPoint(pt) <> FWinHandle; - end; - -var - pt: Windows.POINT; -// Event: TFEvent; - msgp: TfpgMessageParams; -begin - FillChar(msgp, sizeof(msgp), 0); - if not FMouseInWindow then - begin - FMouseInWindow := True; -// DoSetCursor; - Windows.SetCapture(FWinHandle); - //Event := TFEvent.Create; - //try - //Event.lParam := lParam; - //Event.EventType := etMouseEnter; - //ProcessEvent(Event); - //finally - //Event.Free; - //end; - fpgSendMessage(nil, AWindow, FPGM_MOUSEENTER, msgp); - Result := uMsg <> WM_MOUSEMOVE; - end - else - begin - pt.x := LoWord(lParam); - pt.y := HiWord(lParam); - if uMsg = WM_MOUSEWHEEL then - Windows.ScreenToClient(FWinHandle, @pt); - // we should change the Width and Height to ClientWidth, ClientHeight - if (pt.x < 0) or (pt.y < 0) or (pt.x >= Width) or - (pt.y >= Height) or CursorInDifferentWindow then - FMouseInWindow := False; - - if {(not FHasMouseCapture) and} (not FMouseInWindow) then - begin - Windows.ReleaseCapture; - //Event := TFEvent.Create; - //try - //Event.EventType := etMouseLeave; - //ProcessEvent(Event); - //finally - //Event.Free; - //end; - msgp.mouse.x := LoWord(lParam); - msgp.mouse.y := HiWord(lParam); - fpgSendMessage(nil, AWindow, FPGM_MOUSEEXIT, msgp); - Result := False; - end - else - Result := True; - end; -end; - -procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase); -var - wcname: string; - wname: string; - mid: dword; - rwidth: integer; - rheight: integer; - r: TRect; -begin - if FWinHandle > 0 then - Exit; - - FWinStyle := WS_OVERLAPPEDWINDOW; - FWinStyleEx := WS_EX_APPWINDOW; - mid := 0; - wcname := 'FPGWIN'; - - if aparent <> nil then - FParentWinHandle := TfpgWindowImpl(AParent).WinHandle - else - FParentWinHandle := 0; - - if FWindowType = wtChild then - begin - FWinStyle := WS_CHILD; - FWinStyleEx := 0; - mid := 1; - wcname := 'FPGWIDGET'; - end - else if FWindowType in [wtPopup] then - begin - FWinStyle := WS_POPUP; - FWinStyleEx := WS_EX_TOOLWINDOW; - end; - - if FWindowType = wtModalForm then - begin - // for modal windows, this is necessary - FWinStyle := WS_OVERLAPPEDWINDOW or WS_POPUPWINDOW; - FWinStyle := FWinStyle and not (WS_MINIMIZEBOX); - FWinStyleEx := 0; - end; - - AdjustWindowStyle; - - if waAutoPos in FWindowAttributes then - begin - FLeft := TfpgCoord(CW_USEDEFAULT); - FTop := TfpgCoord(CW_USEDEFAULT); - end; - - if (FWindowType <> wtChild) and not (waSizeable in FWindowAttributes) then - FWinStyle := FWinStyle and not (WS_SIZEBOX or WS_MAXIMIZEBOX or WS_MINIMIZEBOX); - - FWinStyle := FWinStyle or WS_CLIPCHILDREN or WS_CLIPSIBLINGS; - - wname := ''; - rwidth := FWidth; - rheight := FHeight; - - if (FWinStyle and WS_CHILD) = 0 then - begin - r.Left := FLeft; - r.Top := FTop; - r.Right := FLeft + FWidth; - r.Bottom := FTop + FHeight; - AdjustWindowRectEx(r, FWinStyle, False, FWinStyleEx); - rwidth := r.Right - r.Left; - rheight := r.Bottom - r.Top; - end; - - FWinHandle := Windows.CreateWindowEx( - FWinStyleEx, // extended window style - PChar(wcname), // registered class name - PChar(wname), // window name - FWinStyle, // window style - FLeft, // horizontal position of window - FTop, // vertical position of window - rwidth, // window width - rheight, // window height - FParentWinHandle, // handle to parent or owner window - mid, // menu handle or child identifier - MainInstance, // handle to application instance - Self // window-creation data - ); - - if waScreenCenterPos in FWindowAttributes then - begin - FLeft := (wapplication.ScreenWidth - FWidth) div 2; - FTop := (wapplication.ScreenHeight - FHeight) div 2; - DoMoveWindow(FLeft, FTop); - end; - - SetWindowParameters; // the forms require some adjustments before the Window appears - - BringWindowToTop(FWinHandle); - - if FWindowType in [wtPopup] then - Windows.ShowWindow(FWinHandle, SW_SHOWNOACTIVATE) - else - Windows.ShowWindow(FWinHandle, SW_SHOWNORMAL); - - if (waAutoPos in FWindowAttributes) or - (waScreenCenterPos in FWindowAttributes) then - begin - GetWindowRect(FWinHandle, r); - FLeft := r.Left; - FTop := r.Top; - end; - - Windows.UpdateWindow(FWinHandle); -end; - -procedure TfpgWindowImpl.DoReleaseWindowHandle; -begin - if FWinHandle <= 0 then - Exit; - Windows.DestroyWindow(FWinHandle); - FWinHandle := 0; -end; - -procedure TfpgWindowImpl.DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); -begin - if HandleIsValid then - Windows.SetWindowPos(WinHandle, 0, x, y, 0, 0, SWP_NOZORDER or SWP_NOSIZE or SWP_NOREDRAW); -end; - -function TfpgWindowImpl.DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; -begin - if not HandleIsValid then - Exit; //==> - - Result.X := AScreenPos.X; - Result.Y := AScreenPos.Y; - ClientToScreen(TfpgWindowImpl(ASource).WinHandle, Result); -end; - -{ -procedure TfpgWindowImpl.MoveToScreenCenter; -var - r : TRECT; -begin - GetWindowRect(WinHandle, r); - FLeft := (wapplication.ScreenWidth-(r.Right - r.Left)) div 2; - FTop := (wapplication.ScreenHeight-(r.Bottom - r.Top)) div 2; - MoveWindow(FLeft,FTop); -end; -} - -procedure TfpgWindowImpl.DoSetWindowTitle(const atitle: string); -begin - {$ifdef wince} - Windows.SetWindowText(WinHandle, PWideChar(Utf8Decode(ATitle))); - {$else} - if UnicodeEnabledOS then - Windows.SetWindowTextW(WinHandle, PWideChar(Utf8Decode(ATitle))) - else - Windows.SetWindowText(WinHandle, PChar(Utf8ToAnsi(ATitle))); - {$endif} -end; - -constructor TfpgWindowImpl.Create(aowner: TComponent); -begin - inherited; - FWinHandle := 0; -end; - -procedure TfpgWindowImpl.CaptureMouse; -begin - Windows.SetCapture(FWinHandle); -end; - -procedure TfpgWindowImpl.ReleaseMouse; -begin - Windows.ReleaseCapture; -end; - -function TfpgWindowImpl.HandleIsValid: boolean; -begin - Result := FWinHandle > 0; -end; - -procedure TfpgWindowImpl.DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); -begin - Windows.SetWindowPos( - WinHandle, 0, - aleft, atop, awidth, aheight, - SWP_NOZORDER or SWP_NOREDRAW - ); -end; - -{ TfpgCanvasImpl } - -constructor TfpgCanvasImpl.Create; -begin - inherited; - FDrawing := False; - FDrawWindow := nil; - FBufferBitmap := 0; -end; - -destructor TfpgCanvasImpl.Destroy; -begin - if FDrawing then - DoEndDraw; - inherited; -end; - -procedure TfpgCanvasImpl.DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); -var - ARect: TfpgRect; - bmsize: Windows.TSIZE; -begin - if FDrawing and buffered and (FBufferBitmap > 0) then - begin - // check if the dimensions are ok - GetBitmapDimensionEx(FBufferBitmap, bmsize); - FDrawWindow := TfpgWindowImpl(awin); - DoGetWinRect(ARect); - if (bmsize.cx <> ARect.Width) or (bmsize.cy <> ARect.Height) then - DoEndDraw; - end; - - if not FDrawing then - begin - FDrawWindow := TfpgWindowImpl(awin); - FWinGC := Windows.GetDC(FDrawWindow.FWinHandle); - - if buffered then - begin - DoGetWinRect(ARect); - FBufferBitmap := Windows.CreateCompatibleBitmap(FWinGC, ARect.Width, ARect.Height); - Fgc := CreateCompatibleDC(FWinGC); - SelectObject(Fgc, FBufferBitmap); - end - else - begin - FBufferBitmap := 0; - Fgc := FWinGC; - end; - - SetTextAlign(Fgc, TA_TOP); //TA_BASELINE); - SetBkMode(Fgc, TRANSPARENT); - - FBrush := CreateSolidBrush(0); - FPen := CreatePen(PS_SOLID, 0, 0); // defaults to black - FClipRegion := CreateRectRgn(0, 0, 1, 1); - - FColor := fpgColorToWin(clText1); - FLineStyle := lsSolid; - FLineWidth := 0; - FBackgroundColor := fpgColorToWin(clBoxColor); - end; - - FDrawing := True; -end; - -procedure TfpgCanvasImpl.DoEndDraw; -begin - if FDrawing then - begin - DeleteObject(FBrush); - DeleteObject(FPen); - DeleteObject(FClipRegion); - - if FBufferBitmap > 0 then - DeleteObject(FBufferBitmap); - FBufferBitmap := 0; - - if Fgc <> FWinGC then - DeleteDC(Fgc); - - Windows.ReleaseDC(FDrawWindow.FWinHandle, FWingc); - - FDrawing := False; - FDrawWindow := nil; - end; -end; - -function TfpgCanvasImpl.GetPixel(X, Y: integer): TfpgColor; -var - c: longword; -begin - c := Windows.GetPixel(Fgc, X, Y); - if c = CLR_INVALID then - Writeln('fpGFX/GDI: TfpgCanvasImpl.GetPixel returned an invalid color'); - Result := WinColorTofpgColor(c); -end; - -procedure TfpgCanvasImpl.SetPixel(X, Y: integer; const AValue: TfpgColor); -begin - Windows.SetPixel(Fgc, X, Y, fpgColorToWin(AValue)); -end; - -procedure TfpgCanvasImpl.DoPutBufferToScreen(x, y, w, h: TfpgCoord); -begin - if FBufferBitmap > 0 then - BitBlt(FWinGC, x, y, w, h, Fgc, x, y, SRCCOPY); -end; - -procedure TfpgCanvasImpl.DoAddClipRect(const rect: TfpgRect); -var - rg: HRGN; -begin - rg := CreateRectRgn(rect.left, rect.top, rect.left + rect.Width, rect.top + rect.Height); - FClipRect := Rect; - FClipRectSet := True; - CombineRgn(FClipRegion, rg, FClipRegion, RGN_AND); - SelectClipRgn(Fgc, FClipRegion); - DeleteObject(rg); -end; - -procedure TfpgCanvasImpl.DoClearClipRect; -begin - SelectClipRgn(Fgc, 0); - FClipRectSet := False; -end; - -procedure TfpgCanvasImpl.DoDrawLine(x1, y1, x2, y2: TfpgCoord); -begin - Windows.MoveToEx(Fgc, x1, y1, nil); - Windows.LineTo(Fgc, x2, y2); -end; - -procedure TfpgCanvasImpl.DoDrawRectangle(x, y, w, h: TfpgCoord); -begin - Windows.MoveToEx(Fgc, x, y, nil); - Windows.LineTo(Fgc, x+w-1, y); - Windows.LineTo(Fgc, x+w-1, y+h-1); - Windows.LineTo(Fgc, x, y+h-1); - Windows.LineTo(Fgc, x, y); -end; - -procedure TfpgCanvasImpl.DoDrawString(x, y: TfpgCoord; const txt: string); -var - WideText: widestring; -begin - if UTF8Length(txt) < 1 then - Exit; //==> - - WideText := Utf8Decode(txt); - {$ifdef wince} - Windows.ExtTextOut(Fgc, x, y, ETO_CLIPPED, nil, PWideChar(WideText), Length(WideText), nil); - {$else} - Windows.TextOutW(Fgc, x, y, PWideChar(WideText), Length(WideText)); - {$endif} -end; - -procedure TfpgCanvasImpl.DoFillRectangle(x, y, w, h: TfpgCoord); -var - wr: Windows.TRect; -begin - wr.Left := x; - wr.Top := y; - wr.Right := x + w; - wr.Bottom := y + h; - Windows.FillRect(Fgc, wr, FBrush); -end; - -procedure TfpgCanvasImpl.DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); -var - pts: array[1..3] of Windows.TPoint; -begin - pts[1].X := x1; - pts[1].Y := y1; - pts[2].X := x2; - pts[2].Y := y2; - pts[3].X := x3; - pts[3].Y := y3; - Windows.Polygon(Fgc, pts, 3); -end; - -function TfpgCanvasImpl.DoGetClipRect: TfpgRect; -begin - Result := FClipRect; -end; - -procedure TfpgCanvasImpl.DoGetWinRect(var r: TfpgRect); -var - wr: Windows.TRECT; -begin - GetClientRect(FDrawWindow.FWinHandle, wr); - r.top := wr.Top; - r.left := wr.Left; - r.Width := wr.Right - wr.Left + 1; - r.Height := wr.Bottom - wr.Top + 1; -end; - -procedure TfpgCanvasImpl.DoSetClipRect(const rect: TfpgRect); -begin - FClipRectSet := True; - FClipRect := rect; - DeleteObject(FClipRegion); - FClipRegion := CreateRectRgn(rect.left, rect.top, rect.left + rect.Width, rect.top + rect.Height); - SelectClipRgn(Fgc, FClipRegion); -end; - -procedure TfpgCanvasImpl.DoSetColor(cl: TfpgColor); -var - newBrush, oldBrush: HBRUSH; - newPen, oldPen: HPEN; -begin - FWindowsColor := fpgColorToWin(cl); - - newBrush := CreateSolidBrush(FWindowsColor); - newPen := CreatePen(FintLineStyle, FLineWidth, FWindowsColor); - oldBrush := SelectObject(Fgc, newBrush); - oldPen := SelectObject(Fgc, newPen); - FBrush := newBrush; - FPen := newPen; - - DeleteObject(oldBrush); - DeleteObject(oldPen); -end; - -procedure TfpgCanvasImpl.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); -var - lw: integer; - lPen: HPEN; -begin -{ Notes from MSDN: If the value specified by nWidth is greater -than 1, the fnPenStyle parameter must be PS_NULL, PS_SOLID, or -PS_INSIDEFRAME. } - FLineWidth := awidth; - case AStyle of - lsDot: - begin - FintLineStyle := PS_DOT; - lw := 1; - end; - lsDash: - begin - FintLineStyle := PS_DASH; - lw := 1; - end; - lsSolid: - begin - FintLineStyle := PS_SOLID; - lw := FLineWidth; - end; - else - begin - FintLineStyle := PS_SOLID; - lw := 1; - end; - end; - - lPen := CreatePen(FintLineStyle, lw, FWindowsColor); - Windows.SelectObject(Fgc, lPen); - Windows.DeleteObject(FPen); - FPen := lPen; -end; - -procedure TfpgCanvasImpl.DoSetTextColor(cl: TfpgColor); -begin - Windows.SetTextColor(Fgc, fpgColorToWin(cl)); -end; - -procedure TfpgCanvasImpl.DoSetFontRes(fntres: TfpgFontResourceBase); -begin - if fntres = nil then - Exit; //==> - FCurFontRes := TfpgFontResourceImpl(fntres); - Windows.SelectObject(Fgc, FCurFontRes.Handle); -end; - -procedure TfpgCanvasImpl.DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); -const - DSTCOPY = $00AA0029; - ROP_DSPDxax = $00E20746; -var - tmpdc: HDC; - rop: longword; -begin - if img = nil then - Exit; //==> - - tmpdc := CreateCompatibleDC(wapplication.display); - SelectObject(tmpdc, TfpgImageImpl(img).BMPHandle); - - if TfpgImageImpl(img).FIsTwoColor then - rop := PATCOPY //ROP_DSPDxax - else - rop := SRCCOPY; - - if TfpgImageImpl(img).MaskHandle > 0 then - MaskBlt(Fgc, x, y, w, h, tmpdc, xi, yi, TfpgImageImpl(img).MaskHandle, xi, yi, MakeRop4(rop, DSTCOPY)) - else - BitBlt(Fgc, x, y, w, h, tmpdc, xi, yi, rop); - - DeleteDC(tmpdc); -end; - -procedure TfpgCanvasImpl.DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); -var - hb: HBRUSH; - nullpen: HPEN; -begin - hb := CreateSolidBrush(fpgColorToWin(fpgColorToRGB(col))); - nullpen := CreatePen(PS_NULL, 0, 0); - - SetROP2(Fgc, R2_XORPEN); - SelectObject(Fgc, hb); - SelectObject(Fgc, nullpen); - - Windows.Rectangle(Fgc, x, y, x + w + 1, y + h + 1); - - SetROP2(Fgc, R2_COPYPEN); - DeleteObject(hb); - SelectObject(Fgc, FPen); -end; - -{ TfpgFontResourceImpl } - -constructor TfpgFontResourceImpl.Create(const afontdesc: string); -begin - FFontData := OpenFontByDesc(afontdesc); - - if HandleIsValid then - begin - SelectObject(wapplication.display, FFontData); - GetTextMetrics(wapplication.display, FMetrics); - end; -end; - -destructor TfpgFontResourceImpl.Destroy; -begin - if HandleIsValid then - Windows.DeleteObject(FFontData); - inherited; -end; - -function TfpgFontResourceImpl.OpenFontByDesc(const desc: string): HFONT; -var - lf: Windows.LOGFONT; - facename: string; - cp: integer; - c: char; - token: string; - prop, propval: string; - - function NextC: char; - begin - Inc(cp); - if cp > length(desc) then - c := #0 - else - c := desc[cp]; - Result := c; - end; - - procedure NextToken; - begin - token := ''; - while (c <> #0) and (c in [' ', 'a'..'z', 'A'..'Z', '_', '0'..'9']) do - begin - token := token + c; - NextC; - end; - end; - -begin - FillChar(lf, sizeof(lf), 0); - - with lf do - begin - lfWidth := 0; { have font mapper choose } - lfEscapement := 0; { only straight fonts } - lfOrientation := 0; { no rotation } - lfWeight := FW_NORMAL; - lfItalic := 0; - lfUnderline := 0; - lfStrikeOut := 0; - lfCharSet := DEFAULT_CHARSET; //0; //Byte(Font.Charset); - lfQuality := ANTIALIASED_QUALITY; - { Everything else as default } - lfOutPrecision := OUT_DEFAULT_PRECIS; - lfClipPrecision := CLIP_DEFAULT_PRECIS; - lfPitchAndFamily := DEFAULT_PITCH; - end; - - cp := 0; - NextC; - NextToken; - - facename := token + #0; - move(facename[1], lf.lfFaceName[0], length(facename)); - - if c = '-' then - begin - NextC; - NextToken; - lf.lfHeight := -MulDiv(StrToIntDef(token, 0), GetDeviceCaps(wapplication.display, LOGPIXELSY), 72); - end; - - while c = ':' do - begin - NextC; - NextToken; - - prop := UpperCase(token); - propval := ''; - - if c = '=' then - begin - NextC; - NextToken; - propval := UpperCase(token); - end; - - if prop = 'BOLD' then - lf.lfWeight := FW_BOLD - else if prop = 'ITALIC' then - lf.lfItalic := 1 - else if prop = 'ANTIALIAS' then - if propval = 'FALSE' then - lf.lfQuality := DEFAULT_QUALITY; - end; - - Result := CreateFontIndirectA(@lf); -end; - -function TfpgFontResourceImpl.HandleIsValid: boolean; -begin - Result := FFontData <> 0; -end; - -function TfpgFontResourceImpl.GetAscent: integer; -begin - Result := FMetrics.tmAscent; -end; - -function TfpgFontResourceImpl.GetDescent: integer; -begin - Result := FMetrics.tmDescent; -end; - -function TfpgFontResourceImpl.GetHeight: integer; -begin - Result := FMetrics.tmHeight; -end; - -function TfpgFontResourceImpl.GetTextWidth(const txt: string): integer; -var - ts: Windows.SIZE; - WideText: widestring; -begin - if length(txt) < 1 then - begin - Result := 0; - Exit; - end; - SelectObject(wapplication.display, FFontData); - - WideText := Utf8Decode(txt); - {$ifdef wince} - Windows.GetTextExtentPoint32(wapplication.display, PWideChar(WideText), Length(WideText), ts); - {$else} - Windows.GetTextExtentPoint32W(wapplication.display, PWideChar(WideText), Length(WideText), ts); - {$endif} - - Result := ts.cx; -end; - -{ TfpgImageImpl } - -constructor TfpgImageImpl.Create; -begin - FBMPHandle := 0; - FMaskHandle := 0; - FIsTwoColor := False; -end; - -procedure TfpgImageImpl.DoFreeImage; -begin - if FBMPHandle > 0 then - DeleteObject(FBMPHandle); - FBMPHandle := 0; - if FMaskHandle > 0 then - DeleteObject(FMaskHandle); - FMaskHandle := 0; -end; - -procedure TfpgImageImpl.DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); -var - bi: TBitmapInfo; -begin - if FBMPHandle > 0 then - DeleteObject(FBMPHandle); - - FBMPHandle := CreateCompatibleBitmap(wapplication.display, awidth, aheight); - - FillChar(bi, sizeof(bi), 0); - - with bi.bmiHeader do - begin - biSize := sizeof(bi); - biWidth := awidth; - biHeight := -aheight; - biPlanes := 1; - if acolordepth = 1 then - bibitcount := 1 - else - bibitcount := 32; - biCompression := BI_RGB; - biSizeImage := 0; - biXPelsPerMeter := 96; - biYPelsPerMeter := 96; - biClrUsed := 0; - biClrImportant := 0; - end; - - SetDIBits(wapplication.display, FBMPHandle, 0, aheight, aimgdata, bi, DIB_RGB_COLORS); - - FIsTwoColor := (acolordepth = 1); -end; - -type - TMyMonoBitmap = packed record - bmiHeader: TBitmapInfoHeader; - bmColors: array[1..2] of longword; - end; - -procedure TfpgImageImpl.DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); -var - bi: TMyMonoBitmap; - pbi: PBitmapInfo; -begin - if FMaskHandle > 0 then - DeleteObject(FMaskHandle); - FMaskHandle := CreateBitmap(awidth, aheight, 1, 1, nil); - FillChar(bi, sizeof(bi), 0); - - with bi.bmiHeader do - begin - biSize := sizeof(bi.bmiHeader); - biWidth := awidth; - biHeight := -aheight; - biPlanes := 1; - bibitcount := 1; - biCompression := BI_RGB; - biSizeImage := 0; - biXPelsPerMeter := 96; - biYPelsPerMeter := 96; - biClrUsed := 2; - biClrImportant := 0; - end; - bi.bmColors[1] := $000000; - bi.bmColors[2] := $FFFFFF; - - pbi := @bi; - SetDIBits(wapplication.display, FMaskHandle, 0, aheight, aimgdata, pbi^, DIB_RGB_COLORS); -end; - -initialization - wapplication := nil; - MouseFocusedWH := 0; - -{$IFDEF WinCE} - UnicodeEnabledOS := True; -{$ELSE} - WinVersion.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); - GetVersionEx(WinVersion); - UnicodeEnabledOS := (WinVersion.dwPlatformID = VER_PLATFORM_WIN32_NT) or - (WinVersion.dwPlatformID = VER_PLATFORM_WIN32_CE); -{$ENDIF} - -end. - diff --git a/prototypes/fpgui2/source/core/gfx_extinterpolation.pas b/prototypes/fpgui2/source/core/gfx_extinterpolation.pas deleted file mode 100644 index 633c1e49..00000000 --- a/prototypes/fpgui2/source/core/gfx_extinterpolation.pas +++ /dev/null @@ -1,585 +0,0 @@ -unit gfx_extinterpolation; - -{ -Some more interpolation filters for TfpgCanvas.StretchDraw: -Bessel, Gaussian and Sinc are infinite impulse response (IIR), -the others are finite impulse response (FIR). The implementation -of Bessel and Sinc are windowed with Blackman filter. - -This unit was ported from fcl-image which is part of FPC. A few -more filters have also been added. -} - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, gfxbase; - -type - - TBlackmanInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TBlackmanSincInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TBlackmanBesselInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TGaussianInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - // a.k.a. "Nearest Neighbour" filter - TBoxInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - THermiteInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TLanczosInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TQuadraticInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TCubicInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TCatromInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TBilinearInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - THanningInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - THammingInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TBSplineInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TBellInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - -implementation - - -// BesselOrderOne: computes Bessel function of x in the first kind of order 0 - -function J1 (x : double) : double; -const Pone : array[0..8] of double = - ( 0.581199354001606143928050809e+21, - -0.6672106568924916298020941484e+20, - 0.2316433580634002297931815435e+19, - -0.3588817569910106050743641413e+17, - 0.2908795263834775409737601689e+15, - -0.1322983480332126453125473247e+13, - 0.3413234182301700539091292655e+10, - -0.4695753530642995859767162166e+7, - 0.270112271089232341485679099e+4 - ); - Qone : array [0..8] of double = - ( 0.11623987080032122878585294e+22, - 0.1185770712190320999837113348e+20, - 0.6092061398917521746105196863e+17, - 0.2081661221307607351240184229e+15, - 0.5243710262167649715406728642e+12, - 0.1013863514358673989967045588e+10, - 0.1501793594998585505921097578e+7, - 0.1606931573481487801970916749e+4, - 0.1e+1 - ); -var - p, q : double; - r : 0..8; -begin - p := Pone[8]; - q := Qone[8]; - for r := 7 downto 0 do - begin - p := p*x*x+pOne[r]; - q := q*X*X+Qone[r]; - end; - result := p / q; -end; - -function P1 (x : double) : double; -const Pone : array[0..5] of double = - ( 0.352246649133679798341724373e+5, - 0.62758845247161281269005675e+5, - 0.313539631109159574238669888e+5, - 0.49854832060594338434500455e+4, - 0.2111529182853962382105718e+3, - 0.12571716929145341558495e+1 - ); - Qone : array [0..5] of double = - ( 0.352246649133679798068390431e+5, - 0.626943469593560511888833731e+5, - 0.312404063819041039923015703e+5, - 0.4930396490181088979386097e+4, - 0.2030775189134759322293574e+3, - 0.1e+1 - ); -var - x8, p, q: double; - r: 0..5; -begin - p := Pone[5]; - q := Qone[5]; - x8 := 8.0 / x; - for r := 4 downto 0 do - begin - p := p*x8*x8+pOne[r]; - q := q*x8*x8+Qone[r]; - end; - result := p / q; -end; - -function Q1 (x : double) : double; -const Pone : array[0..5] of double = - ( 0.3511751914303552822533318e+3, - 0.7210391804904475039280863e+3, - 0.4259873011654442389886993e+3, - 0.831898957673850827325226e+2, - 0.45681716295512267064405e+1, - 0.3532840052740123642735e-1 - ); - Qone : array [0..5] of double = - ( 0.74917374171809127714519505e+4, - 0.154141773392650970499848051e+5, - 0.91522317015169922705904727e+4, - 0.18111867005523513506724158e+4, - 0.1038187585462133728776636e+3, - 0.1e+1 - ); -var - x8, p, q: double; - r : 0..5; -begin - p := Pone[5]; - q := Qone[5]; - x8 := 8.0 / x; - for r := 4 downto 0 do - begin - p := p*x8*x8+pOne[r]; - q := q*x8*x8+Qone[r]; - end; - result := p / q; -end; - -function BesselOrderOne (x : double) : double; -var - p, q, OneOverSqrt2, sinx, cosx: double; -begin - if x = 0.0 then - result := 0.0 - else - begin - p := x; - if x < 0.0 then - x := -x; - if x < 8.0 then - result := p * J1(x) - else - begin - OneOverSqrt2 := 1.0 / sqrt(2.0); - sinx := sin(x); - cosx := cos(x); - result := sqrt(2.0/(PI*x)) * - ( P1(x)*(OneOverSqrt2*(sinx-cosx)) - - 8.0/x*Q1(x)*(-OneOverSqrt2*(sinx+cosx)) - ); - if p < 0.0 then - result := -result; - end - end; -end; - -// Functions to aid calculations - -function Bessel (x : double) : double; -begin - if x = 0.0 then - result := PI / 4.0 - else - result := BesselOrderOne(PI * x) / (2.0 * x); -end; - -function Sinc (x : double) : double; -var xx : double; -begin - if x = 0.0 then - result := 1.0 - else - begin - xx := PI*x; - result := sin(xx) / (xx); - end; -end; - -function Blackman (x : double) : double; -var xpi : double; -begin - xpi := PI * x; - result := 0.42 + 0.5 * cos(xpi) + 0.08 * cos(2*xpi); -end; - -{ THermiteInterpolation } - -function THermiteInterpolation.Filter(x: double): double; -begin - if x < -1.0 then - result := 0.0 - else if x < 0.0 then - result := (2.0*(-x)-3.0)*(-x)*(-x)+1.0 - else if x < 1.0 then - result := (2.0*x-3.0)*x*x+1.0 - else - result := 0; -end; - -function THermiteInterpolation.MaxSupport: double; -begin - result := 1.0; -end; - -{ TLanczosInterpolation } - -function TLanczosInterpolation.Filter(x: double): double; -begin - if x < -3.0 then - result := 0.0 - else if x < 0.0 then - result := sinc(-x)*sinc(-x/3.0) - else if x < 3.0 then - result := sinc(x)*sinc(x/3.0) - else - result := 0.0; -end; - -function TLanczosInterpolation.MaxSupport: double; -begin - result := 3.0; -end; - -{ TQuadraticInterpolation } - -function TQuadraticInterpolation.Filter(x: double): double; -begin - if x < -1.5 then - result := 0.0 - else if x < -0.5 then - begin - x := x + 1.5; - result := 0.5*x*x; - end - else if x < 0.5 then - result := 0.75 - x*x - else if x < 1.5 then - begin - x := x - 1.5; - result := 0.5*x*x; - end - else - result := 0.0; -end; - -function TQuadraticInterpolation.MaxSupport: double; -begin - result := 1.5; -end; - -{ TCubicInterpolation } - -function TCubicInterpolation.Filter(x: double): double; -begin - if x < -2.0 then - result := 0.0 - else if x < -1.0 then - begin - x := x +2.0; - result := x*x*x / 6.0; - end - else if x < 0.0 then - result := (4.0+x*x*(-6.0-3.0*x)) / 6.0 - else if x < 1.0 then - result := (4.0+x*x*(-6.0+3.0*x)) / 6.0 - else if x < 2.0 then - begin - x := 2.0 - x; - result := x*x*x / 6.0; - end - else - result := 0.0; -end; - -function TCubicInterpolation.MaxSupport: double; -begin - result := 2.0; -end; - -{ TCatromInterpolation } - -function TCatromInterpolation.Filter(x: double): double; -begin - if x < -2.0 then - result := 0.0 - else if x < -1.0 then - result := 0.5*(4.0+x*(8.0+x*(5.0+x))) - else if x < 0.0 then - result := 0.5*(2.0+x*x*(-5.0-3.0*x)) - else if x < 1.0 then - result := 0.5*(2.0+x*x*(-5.0+3.0*x)) - else if x < 2.0 then - result := 0.5*(4.0+x*(-8.0+x*(5.0-x))) - else - result := 0.0; -end; - -function TCatromInterpolation.MaxSupport: double; -begin - result := 2.0; -end; - -{ THanningInterpolation } - -function THanningInterpolation.Filter(x: double): double; -begin - if x < -1.0 then - result := 0.0 - else if x <= 1.0 then - result := 0.5+0.5*cos(PI*x) - else - result := 0.0; -end; - -function THanningInterpolation.MaxSupport: double; -begin - result := 1.0; -end; - -{ THammingInterpolation } - -function THammingInterpolation.Filter(x: double): double; -begin - if x < -1.0 then - result := 0.0 - else if x <= 1.0 then - result := 0.54+0.46*cos(PI*x) - else - result := 0.0; -end; - -function THammingInterpolation.MaxSupport: double; -begin - result := 1.0; -end; - -{ TBilinearInterpolation } - -function TBilinearInterpolation.Filter(x: double): double; -begin - if x < -1.0 then - result := 0.0 - else if x < 0.0 then - result := 1 + x - else if x < 1.0 then - result := 1 - x - else - result := 0.0; -end; - -function TBilinearInterpolation.MaxSupport: double; -begin - result := 1.0; -end; - -{ TBoxInterpolation } - -function TBoxInterpolation.Filter(x: double): double; -begin - if x < -0.5 then - result := 0.0 - else if x < 0.5 then - result := 1.0 - else - result := 0.0; -end; - -function TBoxInterpolation.MaxSupport: double; -begin - result := 0.5; -end; - -{ TGaussianInterpolation } - -function TGaussianInterpolation.Filter(x: double): double; -begin - result := exp(-2.0*x*x) * sqrt(2.0/PI); -end; - -function TGaussianInterpolation.MaxSupport: double; -begin - result := 1.25; -end; - -{ TBlackmanBesselInterpolation } - -function TBlackmanBesselInterpolation.Filter(x: double): double; -begin - result := Blackman(x/MaxSupport) * Bessel (x); -end; - -function TBlackmanBesselInterpolation.MaxSupport: double; -begin - Result := 3.2383; -end; - -{ TBlackmanSincInterpolation } - -function TBlackmanSincInterpolation.Filter(x: double): double; -begin - Result := Blackman(x/MaxSupport) * Sinc(x); -end; - -function TBlackmanSincInterpolation.MaxSupport: double; -begin - Result := 4.0; -end; - -{ TBlackmanInterpolation } - -function TBlackmanInterpolation.Filter(x: double): double; -begin - Result := Blackman (x); -end; - -function TBlackmanInterpolation.MaxSupport: double; -begin - Result := 1.0; -end; - -{ TBSplineInterpolation } - -function TBSplineInterpolation.Filter(x: double): double; -var - tt: double; - Value: double; -begin - if (x < 0.0) then - Value := -x - else - Value := x; - - if (Value < 1.0) then - begin - tt := Sqr(Value); - Result := 0.5*tt*Value - tt + 2.0 / 3.0; - end - else if (Value < 2.0) then - begin - Value := 2.0 - Value; - Result := 1.0/6.0 * Sqr(Value) * Value; - end else - Result := 0.0; -end; - -function TBSplineInterpolation.MaxSupport: double; -begin - Result := 2.0; -end; - -{ TBellInterpolation } - -function TBellInterpolation.Filter(x: double): double; -var - Value: double; -begin - if (x < 0.0) then - Value := -x - else - Value := x; - - if (Value < 0.5) then - Result := 0.75 - Sqr(Value) - else if (Value < 1.5) then - begin - Value := Value - 1.5; - Result := 0.5 * Sqr(Value); - end - else - Result := 0.0; -end; - -function TBellInterpolation.MaxSupport: double; -begin - Result := 1.5; -end; - -end. - - diff --git a/prototypes/fpgui2/source/core/gfx_imgfmt_bmp.pas b/prototypes/fpgui2/source/core/gfx_imgfmt_bmp.pas deleted file mode 100644 index 3748d5c7..00000000 --- a/prototypes/fpgui2/source/core/gfx_imgfmt_bmp.pas +++ /dev/null @@ -1,313 +0,0 @@ -{ - BMP format image parser -} - -unit gfx_imgfmt_bmp; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - fpgfx, - gfxbase, fpcanvas; - -procedure ReadImage_BMP(img: TfpgImage; bmp: Pointer; bmpsize: longword); -function LoadImage_BMP(const AFileName: string): TfpgImage; -function CreateImage_BMP(bmp: Pointer; bmpsize: longword): TfpgImage; - -implementation - -function CreateImage_BMP(bmp: Pointer; bmpsize: longword): TfpgImage; -begin - Result := TfpgImage.Create; - ReadImage_BMP(Result, bmp, bmpsize); -end; - -function LoadImage_BMP(const AFileName: string): TfpgImage; -var - AFile: file of char; - AImageData: Pointer; - AImageDataSize: longint; -begin - Result := nil; - if not FileExists(AFileName) then - Exit; //==> - - AssignFile(AFile, AFileName); - FileMode := fmOpenRead; // read-only - Reset(AFile); - AImageDataSize := FileSize(AFile); - GetMem(AImageData, AImageDataSize); - try - BlockRead(AFile, AImageData^, AImageDataSize); - Result := TfpgImage.Create; - ReadImage_BMP(Result, AImageData, AImageDataSize); - finally - CloseFile(AFile); - FreeMem(AImageData); - end; -end; - - -type - // Windows BMP format description: - // Below is the exact order how how information is stored in a BMP file. - - TBMPHeaderRec = packed record - signature: word; - filesize: longword; - reserved: longword; - dataoffset: longword; - end; - PBMPHeaderRec = ^TBMPHeaderRec; - - TBMPInfoHeaderRec = packed record - headersize: longword; // = 40 - Width: longword; - Height: longword; - planes: word; - bitcount: word; - compression: longword; - imagesize: longword; // bytes in the image data (after the color table) - XpixelsPerM: longword; - YpixelsPerM: longword; - ColorsUsed: longword; - ColorsImportant: longword; - end; - PBMPInfoHeaderRec = ^TBMPInfoHeaderRec; - - // Then follows the Color Table if bitcount <= 8 - - TBMPColorTableRec = packed record - red: byte; - green: byte; - blue: byte; - reserved: byte; - end; - - // Then follows the image data - // Every line padded to 32 bits - // The lines stored bottom-up - -type - PByte = ^byte; - Pword = ^word; - Plongword = ^longword; - -procedure ReadImage_BMP(img: TfpgImage; bmp: Pointer; bmpsize: longword); -var - bh: PBMPHeaderRec; - ih: PBMPInfoHeaderRec; - p: PByte; - ppal: plongword; - pcol: Plongword; - palsize: integer; - pdata: PByte; - b: byte; - bit: byte; - bcnt: byte; - linecnt: longword; - pixelcnt: longword; - pdest: Plongword; - depth: integer; - - function GetPalColor(cindex: longword): longword; - var - pc: Plongword; - begin - pc := ppal; - Inc(pc, cindex); - Result := pc^; - end; - -begin - if img = nil then - Exit; //==> - - img.FreeImage; - - p := bmp; - PByte(bh) := p; - ppal := nil; - if bh^.filesize <> bmpsize then - Exit; //==> - - pdata := bmp; - Inc(pdata, bh^.dataoffset); - Inc(p, SizeOf(TBMPHeaderRec)); - PByte(ih) := p; - depth := ih^.bitcount; - - if depth > 1 then - img.AllocateImage(32, ih^.Width, ih^.Height)// color image - else - begin - img.AllocateImage(1, ih^.Width, ih^.Height); - img.AllocateMask; - end; - - //Writeln('width: ',img.width,' height: ',img.height,' depth: ',depth); - //Writeln('compression: ',ih^.compression); - - Inc(p, SizeOf(TBMPInfoHeaderRec)); - - if ih^.bitcount <= 8 then - begin - // reading color palette - case ih^.bitcount of - 1: palsize := 2; - 4: palsize := 16; - else - palsize := 256; - end; - - GetMem(ppal, palsize * SizeOf(longword)); - - pcol := ppal; - pixelcnt := 0; - while integer(p) < integer(pdata) do - begin - pcol^ := Plongword(p)^; - //Writeln('color: ',HexStr(pcol^,8)); - Inc(pcol); - Inc(Plongword(p)); - Inc(pixelcnt); - end; - //writeln(pixelcnt,' colors loaded.'); - end; - - pdest := img.ImageData; - Inc(pdest, img.Width * (img.Height - 1)); // bottom-up line order - p := bmp; - Inc(p, bh^.dataoffset); - - // reading the data... - case ih^.bitcount of - 1: - begin - // direct line transfer - //writeln('reading 1-bit color bitmap'); - linecnt := 0; - bcnt := img.Width div 32; - if (img.Width and $1F) > 0 then - Inc(bcnt); - - pdest := img.ImageData; - Inc(pdest, bcnt * (img.Height - 1)); // bottom-up line order - repeat - move(p^, pdest^, bcnt * 4); - Inc(p, bcnt * 4); - Dec(pdest, bcnt); - Inc(linecnt); - until linecnt >= img.Height; - - //Writeln(linecnt,' lines loaded.'); - move(img.ImageData^, img.MaskData^, img.ImageDataSize); - img.Invert; - end; - - 4: - begin - //writeln('reading 4-bit color'); - linecnt := 0; - repeat - // parse one line.. - bit := 0; - pixelcnt := 0; - bcnt := 0; - repeat - if bit = 0 then - b := (p^ shr 4) and $0F - else - begin - b := p^ and $0F; - Inc(p); - Inc(bcnt); - end; - - pdest^ := GetPalColor(b); - Inc(pdest); - Inc(pixelcnt); - bit := bit xor 1; - until pixelcnt >= img.Width; - - while (bcnt mod 4) <> 0 do - begin - Inc(bcnt); - Inc(p); - end; - - Inc(linecnt); - Dec(pdest, img.Width * 2); // go to next line - until linecnt >= img.Height; - end; - - 8: - begin - //writeln('reading 8-bit color'); - linecnt := 0; - repeat - // parse one line.. - pixelcnt := 0; - repeat - pdest^ := GetPalColor(p^); - Inc(p); - Inc(pdest); - Inc(pixelcnt); - until pixelcnt >= img.Width; - - while (pixelcnt mod 4) <> 0 do - begin - Inc(pixelcnt); - Inc(p); - end; - - Inc(linecnt); - Dec(pdest, img.Width * 2); // go to next line - until linecnt >= img.Height; - end; - - 24: - begin - //writeln('reading truecolor'); - linecnt := 0; - repeat - // parse one line.. - pixelcnt := 0; - repeat - pdest^ := p^; - Inc(p); - pdest^ := pdest^ or (longword(p^) shl 8); - Inc(p); - pdest^ := pdest^ or (longword(p^) shl 16); - Inc(p); - Inc(pdest); - Inc(pixelcnt); - until pixelcnt >= img.Width; - - pixelcnt := img.Width * 3; - while (pixelcnt mod 4) <> 0 do - begin - Inc(pixelcnt); - Inc(p); - end; - - Inc(linecnt); - Dec(pdest, img.Width * 2); // go to next line - until linecnt >= img.Height; - end; - else - writeln('Unsupported BMP format!'); - end; - - if ppal <> nil then - FreeMem(ppal); - - img.UpdateImage; -end; - -end. - diff --git a/prototypes/fpgui2/source/core/gfx_msgqueue.inc b/prototypes/fpgui2/source/core/gfx_msgqueue.inc deleted file mode 100644 index ae893b44..00000000 --- a/prototypes/fpgui2/source/core/gfx_msgqueue.inc +++ /dev/null @@ -1,195 +0,0 @@ - -// fpGFX internal message queue implementation - -type - // a simlpe linked list implementation - TMessageListElement = class - protected - Next: TMessageListElement; - Prev: TMessageListElement; - public - msg: TfpgMessageRec; - end; - -var - // to make things easier we have a few global variable that will get set - UsedFirstMessage: TMessageListElement; - UsedLastMessage: TMessageListElement; - FreeFirstMessage: TMessageListElement; - FreeLastMessage: TMessageListElement; - -procedure MsgListInsertElement(Elem: TMessageListElement; var First: TMessageListElement; var Last: TMessageListElement); -begin - Elem.Prev := nil; - Elem.Next := nil; - - if First = nil then - begin - First := Elem; - Last := Elem; - end - else - begin - Last.Next := Elem; - Elem.Prev := Last; - Last := Elem; - end; -end; - -procedure MsgListRemoveElement(Elem: TMessageListElement; var First: TMessageListElement; var Last: TMessageListElement); -begin - if Elem = First then - First := Elem.Next; - - if Elem = Last then - Last := Elem.Prev; - - if Elem.Next <> nil then - Elem.Next.Prev := Elem.Prev; - - if Elem.Prev <> nil then - Elem.Prev.Next := Elem.Next; -end; - -function pgfAllocateMessage: PfpgMessageRec; -var - e: TMessageListElement; -begin - e := FreeFirstMessage; - if e <> nil then - begin - MsgListRemoveElement(e, FreeFirstMessage, FreeLastMessage); - MsgListInsertElement(e, UsedFirstMessage, UsedLastMessage); - result := @(e.msg); - end - else - result := nil; -end; - -procedure fpgDeleteFirstMessage; -var - e: TMessageListElement; -begin - e := UsedFirstMessage; - if e <> nil then - begin - MsgListRemoveElement(e, UsedFirstMessage, UsedLastMessage); - MsgListInsertElement(e, FreeFirstMessage, FreeLastMessage); - end; -end; - -function fpgGetFirstMessage: PfpgMessageRec; -begin - if UsedFirstMessage <> nil then - Result := @(UsedFirstMessage.msg) - else - Result := nil; -end; - -procedure fpgInitMsgQueue; -var - n: integer; - e: TMessageListElement; -begin - UsedFirstMessage := nil; - UsedLastMessage := nil; - FreeFirstMessage := nil; - FreeLastMessage := nil; - - for n := 1 to cMessageQueueSize do - begin - e := TMessageListElement.Create; - MsgListInsertElement(e,FreeFirstMessage,FreeLastMessage); - end; -end; - -procedure fpgPostMessage(Sender, Dest: TObject; MsgCode: integer; var aparams: TfpgMessageParams); overload; -var - p: PfpgMessageRec; -begin - if Dest = nil then - Exit; //==> - - p := pgfAllocateMessage; - if p <> nil then - begin - p^.MsgCode := MsgCode; - p^.Sender := Sender; - p^.Dest := Dest; - p^.Params := aparams; - end - else - Writeln('THE MESSAGE QUEUE IS FULL.'); -end; - -procedure fpgPostMessage(Sender, Dest: TObject; MsgCode: integer); overload; -var - p: PfpgMessageRec; -begin - if Dest = nil then - Exit; //==> - - p := pgfAllocateMessage; - if p <> nil then - begin - p^.MsgCode := MsgCode; - p^.Sender := Sender; - p^.Dest := Dest; - end - else - Writeln('THE MESSAGE QUEUE IS FULL.'); -end; - -procedure fpgSendMessage(Sender, Dest: TObject; MsgCode: integer; var aparams: TfpgMessageParams); overload; -var - m: TfpgMessageRec; -begin - if Dest = nil then - Exit; //==> - - m.MsgCode := MsgCode; - m.Sender := Sender; - m.Dest := Dest; - m.Params := aparams; - - m.Dest.Dispatch(m) -end; - -procedure fpgSendMessage(Sender, Dest: TObject; MsgCode: integer); overload; -var - m: TfpgMessageRec; -begin - if Dest = nil then - Exit; //==> - - m.MsgCode := MsgCode; - m.Sender := Sender; - m.Dest := Dest; - - m.Dest.Dispatch(m) -end; - -procedure fpgDeliverMessage(var msg: TfpgMessageRec); -begin - if msg.MsgCode = FPGM_KILLME then - msg.Dest.Free - else - msg.Dest.Dispatch(msg); -end; - -procedure fpgDeliverMessages; -var - mp: PfpgMessageRec; - m: TfpgMessageRec; -begin - repeat - mp := fpgGetFirstMessage; - if mp <> nil then - begin - m := mp^; - fpgDeleteFirstMessage; - fpgDeliverMessage(m); - end; - until mp = nil; -end; - diff --git a/prototypes/fpgui2/source/core/gfx_stdimages.pas b/prototypes/fpgui2/source/core/gfx_stdimages.pas deleted file mode 100644 index 27d0ab6c..00000000 --- a/prototypes/fpgui2/source/core/gfx_stdimages.pas +++ /dev/null @@ -1,316 +0,0 @@ -{ - Standard fpGUI images that will be used in things like Message, - FileOpen, FileSave dialogs, Buttons, etc.. -} -unit gfx_stdimages; - -{$mode objfpc}{$H+} - -interface - -uses - fpgfx; - -procedure fpgCreateStandardImages; - -implementation - -{$I stdimages.inc} - -Const - // 60x12 pixel 4bpp bitmap - RadioBitmapData: array[0..359] of Byte = ( - $00, $00, $22, $22, $00, $00, $00, $00, $22, $22, $00, $00, $00, $00, $22, $22, $00, $00, $00, $00, $22, $22, $00, $00, $00, $00, $22, $22, $00, $00, - $00, $22, $11, $11, $22, $00, $00, $22, $11, $11, $22, $00, $00, $22, $11, $11, $22, $00, $00, $22, $11, $11, $22, $00, $00, $22, $11, $11, $22, $00, - $02, $11, $77, $77, $11, $50, $02, $11, $77, $77, $11, $50, $02, $11, $33, $33, $11, $50, $02, $11, $33, $33, $11, $50, $02, $11, $33, $33, $11, $50, - $02, $17, $77, $77, $74, $50, $02, $17, $77, $77, $74, $50, $02, $13, $33, $33, $34, $50, $02, $13, $33, $33, $34, $50, $02, $13, $33, $33, $34, $50, - $21, $77, $77, $77, $77, $45, $21, $77, $76, $67, $77, $45, $21, $33, $33, $33, $33, $45, $21, $33, $36, $63, $33, $45, $21, $33, $32, $23, $33, $45, - $21, $77, $77, $77, $77, $45, $21, $77, $66, $66, $77, $45, $21, $33, $33, $33, $33, $45, $21, $33, $66, $66, $33, $45, $21, $33, $22, $22, $33, $45, - $21, $77, $77, $77, $77, $45, $21, $77, $66, $66, $77, $45, $21, $33, $33, $33, $33, $45, $21, $33, $66, $66, $33, $45, $21, $33, $22, $22, $33, $45, - $21, $77, $77, $77, $77, $45, $21, $77, $76, $67, $77, $45, $21, $33, $33, $33, $33, $45, $21, $33, $36, $63, $33, $45, $21, $33, $32, $23, $33, $45, - $02, $17, $77, $77, $74, $50, $02, $17, $77, $77, $74, $50, $02, $13, $33, $33, $34, $50, $02, $13, $33, $33, $34, $50, $02, $13, $33, $33, $34, $50, - $02, $44, $77, $77, $44, $50, $02, $44, $77, $77, $44, $50, $02, $44, $33, $33, $44, $50, $02, $44, $33, $33, $44, $50, $02, $44, $33, $33, $44, $50, - $00, $55, $44, $44, $55, $00, $00, $55, $44, $44, $55, $00, $00, $55, $44, $44, $55, $00, $00, $55, $44, $44, $55, $00, $00, $55, $44, $44, $55, $00, - $00, $00, $55, $55, $00, $00, $00, $00, $55, $55, $00, $00, $00, $00, $55, $55, $00, $00, $00, $00, $55, $55, $00, $00, $00, $00, $55, $55, $00, $00 - ); - - // 12x12 pixel monochrome bitmap - RadioMaskData: array[0..23] of Byte = ($0f, $00, $3f, $c0, $7f, $e0, $7f, - $e0, $ff, $f0, $ff, $f0, $ff, $f0, $ff, $f0, $7f, $e0, $7f, $e0, $3f, $c0, - $0f, $00); - - // 65x13 pixel 4bpp bitmap - CheckBoxBitmapData: array[0..428] of Byte = ( - $22, $22, $22, $22, $22, $22, $52, $22, $22, $22, $22, $22, $25, $22, $22, $22, $22, $22, $22, $52, $22, $22, $22, $22, $22, $25, $22, $22, $22, $22, $22, $22, $50, - $21, $11, $11, $11, $11, $14, $52, $11, $11, $11, $11, $11, $45, $21, $11, $11, $11, $11, $14, $52, $11, $11, $11, $11, $11, $45, $21, $11, $11, $11, $11, $14, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $77, $77, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $33, $33, $33, $45, $21, $33, $33, $33, $33, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $77, $77, $67, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $33, $33, $63, $45, $21, $33, $33, $33, $32, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $77, $76, $67, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $33, $36, $63, $45, $21, $33, $33, $33, $22, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $67, $77, $66, $67, $45, $21, $33, $33, $33, $33, $34, $52, $13, $63, $33, $66, $63, $45, $21, $32, $33, $32, $22, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $66, $76, $66, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $66, $36, $66, $33, $45, $21, $32, $23, $22, $23, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $66, $66, $67, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $66, $66, $63, $33, $45, $21, $32, $22, $22, $33, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $76, $66, $77, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $36, $66, $33, $33, $45, $21, $33, $22, $23, $33, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $67, $77, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $63, $33, $33, $45, $21, $33, $32, $33, $33, $34, $50, - $21, $77, $77, $77, $77, $74, $52, $17, $77, $77, $77, $77, $45, $21, $33, $33, $33, $33, $34, $52, $13, $33, $33, $33, $33, $45, $21, $33, $33, $33, $33, $34, $50, - $24, $44, $44, $44, $44, $44, $52, $44, $44, $44, $44, $44, $45, $24, $44, $44, $44, $44, $44, $52, $44, $44, $44, $44, $44, $45, $24, $44, $44, $44, $44, $44, $50, - $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $55, $50 - ); - - // 64x8 pixel 4bpp bitmap - ArrowBitmapData: array[0..255] of Byte = ( - $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $13, $33, $33, $31, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $23, $33, $33, $23, $33, $33, - $33, $33, $33, $33, $33, $33, $33, $33, $33, $31, $13, $33, $33, $31, $13, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $32, $25, $33, $33, $22, $33, $33, - $33, $31, $33, $33, $11, $11, $11, $13, $33, $11, $13, $33, $33, $31, $11, $33, $33, $32, $33, $33, $22, $22, $22, $23, $33, $22, $25, $33, $33, $22, $23, $33, - $33, $11, $13, $33, $31, $11, $11, $33, $31, $11, $13, $33, $33, $31, $11, $13, $33, $22, $23, $33, $32, $22, $22, $55, $32, $22, $25, $33, $33, $22, $22, $33, - $31, $11, $11, $33, $33, $11, $13, $33, $33, $11, $13, $33, $33, $31, $11, $33, $32, $22, $22, $33, $33, $22, $25, $53, $33, $22, $25, $33, $33, $22, $25, $53, - $11, $11, $11, $13, $33, $31, $33, $33, $33, $31, $13, $33, $33, $31, $13, $33, $22, $22, $22, $23, $33, $32, $55, $33, $33, $32, $25, $33, $33, $22, $55, $33, - $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $13, $33, $33, $31, $33, $33, $35, $55, $55, $55, $33, $33, $53, $33, $33, $33, $25, $33, $33, $25, $53, $33, - $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $33, $35, $33, $33, $35, $33, $33 - ); - - - -procedure fpgCreateStandardImages; -var - img : TfpgImage; -begin - // system images. Change these to the composite arrow bmp that includes - // disabled state - img := fpgImages.AddBMP( - 'sys.sb.up', - @stdimg_arrow_up, - sizeof(stdimg_arrow_up) ); - - img := fpgImages.AddBMP( - 'sys.sb.down', - @stdimg_arrow_down, - sizeof(stdimg_arrow_down) ); - - img := fpgImages.AddBMP( - 'sys.sb.left', - @stdimg_arrow_left, - sizeof(stdimg_arrow_left) ); - - img := fpgImages.AddBMP( - 'sys.sb.right', - @stdimg_arrow_right, - sizeof(stdimg_arrow_right) ); - - // Add RadioButton, CheckBox images as well. - - - // General purpose images: - img := fpgImages.AddMaskedBMP( - 'stdimg.ok', - @stdimg_btn_ok_16, - sizeof(stdimg_btn_ok_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.cancel', - @stdimg_btn_cancel_16, - sizeof(stdimg_btn_cancel_16), 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.yes', - @stdimg_choice_yes_16, - sizeof(stdimg_choice_yes_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.no', - @stdimg_choice_no_16, - sizeof(stdimg_choice_no_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.close', - @stdimg_btn_close_16, - sizeof(stdimg_btn_close_16), 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.quit', - @stdimg_menu_quit_16, - sizeof(stdimg_menu_quit_16), 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.exit', - @stdimg_menu_exit_16, - sizeof(stdimg_menu_exit_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.configure', - @stdimg_menu_preferences_16, - sizeof(stdimg_menu_preferences_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.document', - @stdimg_document, - sizeof(stdimg_document), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.search', - @stdimg_search_16, - sizeof(stdimg_search_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.refresh', - @stdimg_refresh_16, - sizeof(stdimg_refresh_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.font', - @stdimg_font_16, - sizeof(stdimg_font_16), - 15,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.copy', - @stdimg_edit_copy_16, - sizeof(stdimg_edit_copy_16), - 15,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.cut', - @stdimg_edit_cut_16, - sizeof(stdimg_edit_cut_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.paste', - @stdimg_edit_paste_16, - sizeof(stdimg_edit_paste_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.delete', - @stdimg_edit_delete_16, - sizeof(stdimg_edit_delete_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.edit', - @stdimg_edit, - sizeof(stdimg_edit), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.folder', - @stdimg_folder_16, - sizeof(stdimg_folder_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.foldernew', - @stdimg_folder_new_16, - sizeof(stdimg_folder_new_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.folderopen', - @stdimg_folder_open_16, - sizeof(stdimg_folder_open_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.folderup', - @stdimg_folder_up_16, - sizeof(stdimg_folder_up_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.open', - @stdimg_folder_open_16, - sizeof(stdimg_folder_open_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.save', - @stdimg_menu_save_16, - sizeof(stdimg_menu_save_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.saveas', - @stdimg_menu_saveas_16, - sizeof(stdimg_menu_saveas_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.saveall', - @stdimg_menu_save_all_16, - sizeof(stdimg_menu_save_all_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.help', - @stdimg_help_16, - sizeof(stdimg_help_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.hidden', - @stdimg_hidden, - sizeof(stdimg_hidden), - 0,0 ); - - img := fpgImages.AddBMP( - 'stdimg.link', - @stdimg_link, - sizeof(stdimg_link) - ); - img := fpgImages.AddMaskedBMP( - 'stdimg.add', - @stdimg_list_add_16, - sizeof(stdimg_list_add_16), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.remove', - @stdimg_list_remove_16, - sizeof(stdimg_list_remove_16), - 0,0 ); - - - // Dialog icons - img := fpgImages.AddMaskedBMP( - 'stdimg.dlg.help', - @stdimg_dialog_confirmation_32, - sizeof(stdimg_dialog_confirmation_32), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.dlg.info', - @stdimg_dialog_information_32, - sizeof(stdimg_dialog_information_32), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.dlg.warning', - @stdimg_dialog_warning_32, - sizeof(stdimg_dialog_warning_32), - 0,0 ); - - img := fpgImages.AddMaskedBMP( - 'stdimg.dlg.critical', - @stdimg_dialog_error_32, - sizeof(stdimg_dialog_error_32), - 0,0 ); - -{ - Here is a template for more images - - img := fpgImages.AddMaskedBMP( - 'stdimg.', - @stdimg_, - sizeof(stdimg_), 0,0 ); -} -end; - -end. - diff --git a/prototypes/fpgui2/source/core/gfx_utf8utils.pas b/prototypes/fpgui2/source/core/gfx_utf8utils.pas deleted file mode 100644 index 6734a9d5..00000000 --- a/prototypes/fpgui2/source/core/gfx_utf8utils.pas +++ /dev/null @@ -1,142 +0,0 @@ -{ - Some handly UTF8 function copied from the Lazarus LCL. Surely we can move - this into FPC? -} -unit gfx_UTF8utils; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils; - - -function UTF8Pos(const SearchForText, SearchInText: string): integer; -function UTF8Copy(const s: string; StartCharIndex, CharCount: integer): string; -function UTF8Length(const s: string): integer; -function UTF8Length(p: PChar; ByteCount: integer): integer; -function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar; -function UTF8CharacterLength(p: PChar): integer; - -{$Note I believe we need a UTF8Delete and UTF8Insert as well. } - - -implementation - -// returns the character index, where the SearchForText starts in SearchInText -function UTF8Pos(const SearchForText, SearchInText: string): integer; -var - p: LongInt; -begin - p:=System.Pos(SearchForText,SearchInText); - if p>0 then - Result:=UTF8Length(PChar(SearchInText),p-1)+1 - else - Result:=0; -end; - -// returns substring -function UTF8Copy(const s: string; StartCharIndex, CharCount: integer): string; -var - StartBytePos: PChar; - EndBytePos: PChar; - MaxBytes: PtrInt; -begin - StartBytePos:=UTF8CharStart(PChar(s),length(s),StartCharIndex-1); - if StartBytePos=nil then - Result:='' - else - begin - MaxBytes:=PtrInt(PChar(s)+length(s)-StartBytePos); - EndBytePos:=UTF8CharStart(StartBytePos,MaxBytes,CharCount); - if EndBytePos=nil then - Result:=copy(s,StartBytePos-PChar(s)+1,MaxBytes) - else - Result:=copy(s,StartBytePos-PChar(s)+1,EndBytePos-StartBytePos); - end; -end; - -function UTF8Length(const s: string): integer; -begin - Result := UTF8Length(PChar(s),length(s)); -end; - -function UTF8Length(p: PChar; ByteCount: integer): integer; -var - CharLen: LongInt; -begin - Result:=0; - while (ByteCount>0) do - begin - inc(Result); - CharLen:=UTF8CharacterLength(p); - inc(p,CharLen); - dec(ByteCount,CharLen); - end; -end; - -function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar; -var - CharLen: LongInt; -begin - Result:=UTF8Str; - if Result<>nil then - begin - while (Index>0) and (Len>0) do - begin - CharLen:=UTF8CharacterLength(Result); - dec(Len,CharLen); - dec(Index); - inc(Result,CharLen); - end; - if (Index>0) or (Len<0) then - Result:=nil; - end; -end; - -function UTF8CharacterLength(p: PChar): integer; -begin - if p<>nil then - begin - if ord(p^)< %11000000 then - begin - // regular single byte character (#0 is a character, this is pascal ;) - Result:=1; - end - else if ((ord(p^) and %11100000) = %11000000) then - begin - // could be 2 byte character - if (ord(p[1]) and %11000000) = %10000000 then - Result:=2 - else - Result:=1; - end - else if ((ord(p^) and %11110000) = %11100000) then - begin - // could be 3 byte character - if ((ord(p[1]) and %11000000) = %10000000) - and ((ord(p[2]) and %11000000) = %10000000) then - Result:=3 - else - Result:=1; - end - else if ((ord(p^) and %11111000) = %11110000) then - begin - // could be 4 byte character - if ((ord(p[1]) and %11000000) = %10000000) - and ((ord(p[2]) and %11000000) = %10000000) - and ((ord(p[3]) and %11000000) = %10000000) then - Result:=4 - else - Result:=1; - end - else - Result:=1; - end - else - Result:=0; -end; - -end. - diff --git a/prototypes/fpgui2/source/core/gfx_widget.pas b/prototypes/fpgui2/source/core/gfx_widget.pas deleted file mode 100644 index 5cb5281d..00000000 --- a/prototypes/fpgui2/source/core/gfx_widget.pas +++ /dev/null @@ -1,850 +0,0 @@ -unit gfx_widget; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - fpgfx, - gfxbase; - -type - TFocusSearchDirection = (fsdFirst, fsdLast, fsdNext, fsdPrev); - - { TfpgWidget } - - TfpgWidget = class(TfpgWindow) - private - FAlignRect: TfpgRect; - FOnMouseDown: TMouseButtonEvent; - FOnMouseEnter: TNotifyEvent; - FOnMouseExit: TNotifyEvent; - FOnMouseMove: TMouseMoveEvent; - FOnMouseUp: TMouseButtonEvent; - FOnPaint: TPaintEvent; - FOnScreen: boolean; - procedure MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT; - procedure MsgResize(var msg: TfpgMessageRec); message FPGM_RESIZE; - procedure MsgMove(var msg: TfpgMessageRec); message FPGM_MOVE; - procedure MsgKeyChar(var msg: TfpgMessageRec); message FPGM_KEYCHAR; - procedure MsgKeyPress(var msg: TfpgMessageRec); message FPGM_KEYPRESS; - procedure MsgKeyRelease(var msg: TfpgMessageRec); message FPGM_KEYRELEASE; - procedure MsgMouseDown(var msg: TfpgMessageRec); message FPGM_MOUSEDOWN; - procedure MsgMouseUp(var msg: TfpgMessageRec); message FPGM_MOUSEUP; - procedure MsgMouseMove(var msg: TfpgMessageRec); message FPGM_MOUSEMOVE; - procedure MsgDoubleClick(var msg: TfpgMessageRec); message FPGM_DOUBLECLICK; - procedure MsgMouseEnter(var msg: TfpgMessageRec); message FPGM_MOUSEENTER; - procedure MsgMouseExit(var msg: TfpgMessageRec); message FPGM_MOUSEEXIT; - procedure MsgMouseScroll(var msg: TfpgMessageRec); message FPGM_SCROLL; - procedure SetActiveWidget(const AValue: TfpgWidget); - procedure SetEnabled(const AValue: boolean); - procedure SetVisible(const AValue: boolean); - protected - FVisible: boolean; - FEnabled: boolean; - FFocusable: boolean; - FFocused: boolean; - FTabOrder: integer; - FAnchors: TAnchors; - FActiveWidget: TfpgWidget; - FAlign: TAlign; - function GetParent: TfpgWidget; reintroduce; - procedure SetParent(const AValue: TfpgWidget); reintroduce; - procedure DoAlign(aalign: TAlign); - procedure HandlePaint; virtual; - procedure HandleResize(awidth, aheight: TfpgCoord); virtual; - procedure HandleMove(x, y: TfpgCoord); virtual; - procedure HandleKeyChar(var AText: string; var shiftstate: TShiftState; var consumed: boolean); virtual; - procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); virtual; - procedure HandleKeyRelease(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); virtual; - procedure HandleSetFocus; virtual; - procedure HandleKillFocus; virtual; - procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); virtual; - procedure HandleRMouseDown(x, y: integer; shiftstate: TShiftState); virtual; - procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); virtual; - procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); virtual; - procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); virtual; - procedure HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); virtual; - procedure HandleMouseEnter; virtual; - procedure HandleMouseExit; virtual; - procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); virtual; - function FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget; - procedure HandleAlignments(dwidth, dheight: TfpgCoord); virtual; - procedure HandleShow; virtual; - procedure HandleHide; virtual; - procedure MoveAndResize(aleft, atop, awidth, aheight: TfpgCoord); - procedure MoveAndResizeBy(dx, dy, dw, dh: TfpgCoord); - procedure SetPosition(aleft, atop, awidth, aheight: TfpgCoord); - procedure RePaint; - { property events } - property OnPaint: TPaintEvent read FOnPaint write FOnPaint; - property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit; - property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; - property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; - property OnMouseDown: TMouseButtonEvent read FOnMouseDown write FOnMouseDown; - property OnMouseUp: TMouseButtonEvent read FOnMouseUp write FOnMouseUp; - //property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure SetFocus; - procedure KillFocus; - property Parent: TfpgWidget read GetParent write SetParent; - property ActiveWidget: TfpgWidget read FActiveWidget write SetActiveWidget; - property Visible: boolean read FVisible write SetVisible; - property Enabled: boolean read FEnabled write SetEnabled; - property TabOrder: integer read FTabOrder write FTabOrder; - property Focusable: boolean read FFocusable write FFocusable; - property Focused: boolean read FFocused write FFocused; - property Anchors: TAnchors read FAnchors write FAnchors; - property Align: TAlign read FAlign write FAlign; - end; - - -var - FocusRootWidget: TfpgWidget; - - -function FindKeyboardFocus: TfpgWidget; - -implementation - -function FindKeyboardFocus: TfpgWidget; -begin - Result := nil; - - if FocusRootWidget <> nil then - begin - Result := FocusRootWidget; - while (Result <> nil) and (Result.ActiveWidget <> nil) do - Result := Result.ActiveWidget; - end; -end; - - -{ TfpgWidget } - -procedure TfpgWidget.SetEnabled(const AValue: boolean); -begin - if FEnabled = AValue then - Exit; - FEnabled := AValue; - RePaint; -end; - -procedure TfpgWidget.SetActiveWidget(const AValue: TfpgWidget); -begin - if FActiveWidget = AValue then - Exit; //==> - if FActiveWidget <> nil then - FActiveWidget.HandleKillFocus; - FActiveWidget := AValue; - if FActiveWidget <> nil then - FActiveWidget.HandleSetFocus; -end; - -procedure TfpgWidget.SetVisible(const AValue: boolean); -begin - if FVisible = AValue then - Exit; //==> - FVisible := AValue; - if FOnScreen then - if FVisible then - HandleShow - else - begin - HandleHide; - FOnScreen := True; - end; -end; - -function TfpgWidget.GetParent: TfpgWidget; -begin - Result := TfpgWidget(inherited GetParent); -end; - -procedure TfpgWidget.SetParent(const AValue: TfpgWidget); -begin - inherited SetParent(AValue); -end; - -constructor TfpgWidget.Create(AOwner: TComponent); -begin - FOnScreen := False; - FVisible := True; - FActiveWidget := nil; - FEnabled := True; - FFocusable := False; - FFocused := False; - FTabOrder := 0; - FAnchors := [anLeft, anTop]; - FAlign := alNone; -// OnKeyPress := nil; - - if (AOwner <> nil) and (AOwner is TfpgWidget) then - Parent := TfpgWidget(AOwner) - else - Parent := nil; - - if Parent <> nil then - FWindowType := wtChild; - - inherited; -end; - -destructor TfpgWidget.Destroy; -begin - HandleHide; - inherited; -end; - -procedure TfpgWidget.MsgKeyChar(var msg: TfpgMessageRec); -var - lText: string; - ss: TShiftState; - consumed: boolean; - wg: TfpgWidget; -begin - lText := msg.params.keyboard.keychar; - ss := msg.params.keyboard.shiftstate; - - consumed := False; - HandleKeyChar(lText, ss, consumed); - - if not consumed then - begin - wg := Parent; - while (not consumed) and (wg <> nil) do - begin - wg.HandleKeyChar(lText, ss, consumed); - wg := wg.Parent; - end; - end; -end; - -procedure TfpgWidget.MsgKeyPress(var msg: TfpgMessageRec); -var - key: word; - ss: TShiftState; - consumed: boolean; - wg: TfpgWidget; -begin - key := msg.params.keyboard.keycode; - ss := msg.params.keyboard.shiftstate; - consumed := False; - - HandleKeyPress(key, ss, consumed); - if not consumed then - begin - wg := Parent; - while (not consumed) and (wg <> nil) do - begin - wg.HandleKeyPress(key, ss, consumed); - wg := wg.Parent; - end; - end; -end; - -procedure TfpgWidget.MsgKeyRelease(var msg: TfpgMessageRec); -var - key: word; - ss: TShiftState; - consumed: boolean; - wg: TfpgWidget; -begin - key := msg.params.keyboard.keycode; - ss := msg.params.keyboard.shiftstate; - consumed := False; - - HandleKeyRelease(key, ss, consumed); - if not consumed then - begin - wg := Parent; - while (not consumed) and (wg <> nil) do - begin - wg.HandleKeyRelease(key, ss, consumed); - wg := wg.Parent; - end; - end; -end; - -procedure TfpgWidget.MsgMouseDown(var msg: TfpgMessageRec); -var - mb: TMouseButton; -begin - case msg.Params.mouse.Buttons of - MOUSE_LEFT: - begin - mb := mbLeft; - HandleLMouseDown(msg.Params.mouse.x, msg.Params.mouse.y, msg.Params.mouse.shiftstate); - end; - MOUSE_RIGHT: - begin - mb := mbRight; - HandleRMouseDown(msg.Params.mouse.x, msg.Params.mouse.y, msg.Params.mouse.shiftstate); - end; - MOUSE_MIDDLE: - begin - mb := mbMiddle; - end; - end; - if Assigned(FOnMouseDown) then - FOnMouseDown(self, mb, msg.Params.mouse.shiftstate, - Point(msg.Params.mouse.x, msg.Params.mouse.y)); -end; - -procedure TfpgWidget.MsgMouseUp(var msg: TfpgMessageRec); -var - mb: TMouseButton; -begin - case msg.Params.mouse.Buttons of - MOUSE_LEFT: - begin - mb := mbLeft; - HandleLMouseUp(msg.Params.mouse.x, msg.Params.mouse.y, msg.Params.mouse.shiftstate); - end; - MOUSE_RIGHT: - begin - mb := mbRight; - HandleRMouseUp(msg.Params.mouse.x, msg.Params.mouse.y, msg.Params.mouse.shiftstate); - end; - MOUSE_MIDDLE: - begin - mb := mbMiddle; - end; - end; - if Assigned(FOnMouseUp) then - FOnMouseUp(self, mb, msg.Params.mouse.shiftstate, - Point(msg.Params.mouse.x, msg.Params.mouse.y)); -end; - -procedure TfpgWidget.MsgMouseMove(var msg: TfpgMessageRec); -begin - HandleMouseMove(msg.Params.mouse.x, msg.Params.mouse.y, msg.Params.mouse.Buttons, msg.Params.mouse.shiftstate); - if Assigned(OnMouseMove) then - OnMouseMove(self, msg.Params.mouse.shiftstate, - Point(msg.Params.mouse.x, msg.Params.mouse.y)); -end; - -procedure TfpgWidget.MsgDoubleClick(var msg: TfpgMessageRec); -begin - // If we don't generate a mouse down, we get a rapid click - // delay under Windows. - HandleLMouseDown(msg.Params.mouse.x, msg.Params.mouse.y, msg.Params.mouse.shiftstate); -end; - -procedure TfpgWidget.MsgMouseEnter(var msg: TfpgMessageRec); -begin - HandleMouseEnter; - if Assigned(FOnMouseEnter) then - FOnMouseEnter(self); -end; - -procedure TfpgWidget.MsgMouseExit(var msg: TfpgMessageRec); -begin - HandleMouseExit; - if Assigned(FOnMouseExit) then - FOnMouseExit(Self); -end; - -procedure TfpgWidget.MsgMouseScroll(var msg: TfpgMessageRec); -begin - HandleMouseScroll(msg.Params.mouse.x, msg.Params.mouse.y, - msg.Params.mouse.shiftstate, msg.Params.mouse.delta); -end; - -procedure TfpgWidget.HandleShow; -var - n: integer; - c: TComponent; -begin - FOnScreen := True; - if FVisible then - begin - AllocateWindowHandle; - - for n := 0 to ComponentCount - 1 do - begin - c := Components[n]; - if (c is TfpgWidget) and (TfpgWidget(c).Parent = self) then - TfpgWidget(c).HandleShow; - end; - end; -end; - -procedure TfpgWidget.HandleHide; -var - n: integer; - c: TComponent; -begin - for n := 0 to ComponentCount - 1 do - begin - c := Components[n]; - if (c is TfpgWidget) and (TfpgWidget(c).Parent = self) then - TfpgWidget(c).HandleHide; - end; - FOnScreen := False; - - ReleaseWindowHandle; -end; - -procedure TfpgWidget.RePaint; -begin - if HasHandle then - HandlePaint; -end; - -procedure TfpgWidget.SetFocus; -begin - HandleSetFocus; -end; - -procedure TfpgWidget.KillFocus; -begin - HandleKillFocus; -end; - -procedure TfpgWidget.HandlePaint; -begin - // descendants will implement this. -end; - -procedure TfpgWidget.HandleKeyChar(var AText: string; var shiftstate: TShiftState; var consumed: boolean); -begin - // descendants will implement this. -end; - -procedure TfpgWidget.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; - var consumed: boolean); -var - wg: TfpgWidget; - dir: integer; -begin - //if Assigned(OnKeyPress) then - //OnKeyPress(self, keycode, shiftstate, consumed); - - if consumed then - Exit; //==> - - dir := 0; - - case keycode of - keyTab: - if (ssShift in shiftstate) then - dir := -1 - else - dir := 1; - - keyReturn, - keyDown, - keyRight: - dir := 1; - - keyUp, - keyLeft: - dir := -1; - end; - - {$Note Optimize this code. Constantly setting ActiveWidget causes RePaint to be called!} - if dir = 1 then - begin - // forward - wg := FindFocusWidget(ActiveWidget, fsdNext); - ActiveWidget := wg; - if wg <> nil then - consumed := True - else - begin - if Parent = nil then - begin - wg := FindFocusWidget(ActiveWidget, fsdFirst); - ActiveWidget := wg; - consumed := True; - end; - end; - end - else if dir = -1 then - begin - // backward - wg := FindFocusWidget(ActiveWidget, fsdPrev); - ActiveWidget := wg; - if wg <> nil then - begin - consumed := True; - // we must find the last one! - while wg <> nil do - begin - wg.ActiveWidget := wg.FindFocusWidget(ActiveWidget, fsdLast); - wg := wg.ActiveWidget; - end; - end - else if Parent = nil then - begin - wg := FindFocusWidget(ActiveWidget, fsdLast); - ActiveWidget := wg; - consumed := True; - end; - end; -end; - -procedure TfpgWidget.HandleKeyRelease(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); -begin - // descendants will implement this. -end; - -procedure TfpgWidget.HandleSetFocus; -var - awg: TfpgWidget; -begin - if not FFocused then - begin - FFocused := True; - RePaint; - // focusing a child - if ActiveWidget <> nil then - ActiveWidget.SetFocus - else - begin - // try to find it for the first time. - awg := FindFocusWidget(nil, fsdFirst); - if awg <> nil then - ActiveWidget := awg; - end; - end; - - if Parent <> nil then - begin - Parent.ActiveWidget := self; - Parent.SetFocus; - end; -end; - -procedure TfpgWidget.HandleKillFocus; -begin - FFocused := False; - RePaint; - - if ActiveWidget <> nil then - ActiveWidget.KillFocus; -end; - -procedure TfpgWidget.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); -var - pw: TfpgWidget; - w: TfpgWidget; -begin - // setting the focus through all parents - pw := Parent; - w := self; - while pw <> nil do - begin - if w.Visible and w.Enabled and w.Focusable then - pw.ActiveWidget := w; - w := pw; - pw := pw.Parent; - end; -end; - -procedure TfpgWidget.HandleRMouseDown(x, y: integer; shiftstate: TShiftState); -begin - // do nothing yet -end; - -procedure TfpgWidget.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); -begin - // do nothing yet -end; - -procedure TfpgWidget.HandleRMouseUp(x, y: integer; shiftstate: TShiftState); -begin - // do nothing yet -end; - -procedure TfpgWidget.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); -begin - // do nothing yet -end; - -procedure TfpgWidget.HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); -begin - // do nothing yet -end; - -procedure TfpgWidget.HandleMouseEnter; -begin - // do nothing yet -end; - -procedure TfpgWidget.HandleMouseExit; -begin - // do nothing yet -end; - -procedure TfpgWidget.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); -begin - // do nothing yet -end; - -function TfpgWidget.FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget; -var - w: TfpgWidget; - n: integer; - FoundIt: boolean; - lasttaborder: integer; -begin - Result := nil; - FoundIt := False; - if direction in [fsdLast, fsdPrev] then - lasttaborder := -999999 - else - lasttaborder := 999999; - - for n := 0 to ComponentCount - 1 do - if Components[n] is TfpgWidget then - begin - w := TfpgWidget(Components[n]); - - if w.Visible and w.Enabled and w.Focusable then - case direction of - fsdFirst: - if w.TabOrder < lasttaborder then - begin - Result := w; - lasttaborder := w.TabOrder; - end; - - fsdLast: - if lasttaborder <= w.TabOrder then - begin - Result := w; - lasttaborder := w.TabOrder; - end; - - fsdNext: - if startwg = w then - FoundIt := True - else if w.TabOrder < lasttaborder then - if (startwg = nil) or - (w.TabOrder > startwg.TabOrder) or - (FoundIt and (w.TabOrder = startwg.TabOrder)) then - begin - Result := w; - lasttaborder := w.TabOrder; - end; - - fsdPrev: - if startwg = w then - FoundIt := True - else if w.TabOrder >= lasttaborder then - if (startwg = nil) or - (w.TabOrder < startwg.TabOrder) or - (not FoundIt and (w.TabOrder = startwg.TabOrder)) then - begin - Result := w; - lasttaborder := w.TabOrder; - end; - - end; - end; -end; - -procedure TfpgWidget.MsgPaint(var msg: TfpgMessageRec); -begin - HandlePaint; - if Assigned(FOnPaint) then - FOnPaint(Self); -end; - -procedure TfpgWidget.MsgResize(var msg: TfpgMessageRec); -begin - HandleResize(msg.Params.rect.Width, msg.params.rect.Height); -end; - -procedure TfpgWidget.HandleResize(awidth, aheight: TfpgCoord); -var - dw: integer; - dh: integer; -begin - dw := awidth - FWidth; - dh := aheight - FHeight; - FWidth := awidth; - FHeight := aheight; - HandleAlignments(dw, dh); -end; - -procedure TfpgWidget.MsgMove(var msg: TfpgMessageRec); -begin - HandleMove(msg.Params.rect.left, msg.Params.rect.top); -end; - -procedure TfpgWidget.HandleMove(x, y: TfpgCoord); -begin - FLeft := x; - FTop := y; -end; - -procedure TfpgWidget.HandleAlignments(dwidth, dheight: TfpgCoord); -var - n: integer; - wg: TfpgWidget; - dx: integer; - dy: integer; - dw: integer; - dh: integer; -begin - FAlignRect.top := 0; - FAlignRect.Left := 0; - FAlignRect.Width := Width; - FAlignRect.Height := Height; - - DoAlign(alTop); - DoAlign(alBottom); - DoAlign(alLeft); - DoAlign(alRight); - DoAlign(alClient); - - // handle anchors finally for alNone - for n := 0 to ComponentCount - 1 do - if (Components[n] is TfpgWidget) then - begin - wg := TfpgWidget(Components[n]); - - if (wg.FAlign = alNone) and - (anBottom in wg.Anchors) or (anRight in wg.Anchors) then - begin - // we must alter the window - dx := 0; - dy := 0; - dw := 0; - dh := 0; - - if (anLeft in wg.Anchors) and (anRight in wg.Anchors) then - dw := dwidth - else if anRight in wg.Anchors then - dx := dwidth; - - if (anTop in wg.Anchors) and (anBottom in wg.Anchors) then - dh := dheight - else if anBottom in wg.Anchors then - dy := dheight; - - wg.MoveAndResizeBy(dx, dy, dw, dh); - end; - end; - - RePaint; -end; - -procedure TfpgWidget.MoveAndResize(aleft, atop, awidth, aheight: TfpgCoord); -begin - if (aleft <> FLeft) or (atop <> FTop) then - HandleMove(aleft, atop); - if (awidth <> FWidth) or (aheight <> FHeight) then - HandleResize(awidth, aheight); - - UpdateWindowPosition; -end; - -procedure TfpgWidget.MoveAndResizeBy(dx, dy, dw, dh: TfpgCoord); -begin - if (dx <> 0) or (dy <> 0) or - (dw <> 0) or (dh <> 0) then - MoveAndResize(FLeft + dx, FTop + dy, FWidth + dw, FHeight + dh); -end; - -function CompareInts(i1, i2: integer): integer; -begin - if i1 < i2 then - Result := -1 - else if i1 > i2 then - Result := 1 - else - Result := 0; -end; - -function AlignCompare(p1, p2: Pointer): integer; -var - w1: TfpgWidget; - w2: TfpgWidget; -begin - w1 := TfpgWidget(p1); - w2 := TfpgWidget(p2); - case w1.Align of - alTop: Result := CompareInts(w1.Top, w2.Top); - alBottom: Result := CompareInts(w2.Top, w1.Top); - alLeft: Result := CompareInts(w1.Left, w2.Left); - alRight: Result := CompareInts(w2.Left, w1.Left); - else - Result := 0; - end; -end; - -procedure TfpgWidget.DoAlign(aalign: TAlign); -var - alist: TList; - w: TfpgWidget; - n: integer; -begin - alist := TList.Create; - for n := 0 to ComponentCount - 1 do - if Components[n] is TfpgWidget then - begin - w := TfpgWidget(Components[n]); - if w.Align = aalign then - alist.Add(w); - end; - - alist.Sort(@AlignCompare); - - // and process this list in order - for n := 0 to alist.Count - 1 do - begin - w := TfpgWidget(alist[n]); - case aalign of - alTop: - begin - w.MoveAndResize(FAlignRect.Left, FAlignRect.Top, FAlignRect.Width, w.Height); - Inc(FAlignRect.top, w.Height); - Dec(FAlignRect.Height, w.Height); - end; - - alBottom: - begin - w.MoveAndResize(FAlignRect.Left, FAlignRect.Top + FAlignRect.Height - w.Height, FAlignRect.Width, w.Height); - Dec(FAlignRect.Height, w.Height); - end; - - alLeft: - begin - w.MoveAndResize(FAlignRect.Left, FAlignRect.Top, w.Width, FAlignRect.Height); - Inc(FAlignRect.Left, w.Width); - Dec(FAlignRect.Width, w.Width); - end; - - alRight: - begin - w.MoveAndResize(FAlignRect.Left + FAlignRect.Width - w.Width, FAlignRect.Top, w.Width, FAlignRect.Height); - Dec(FAlignRect.Width, w.Width); - end; - - alClient: - w.MoveAndResize(FAlignRect.Left, FAlignRect.Top, FAlignRect.Width, FAlignRect.Height); - end; { case } - end; - - alist.Free; -end; - -procedure TfpgWidget.SetPosition(aleft, atop, awidth, aheight: TfpgCoord); -begin - MoveAndResize(aleft, atop, awidth, aheight); -end; - - -initialization - FocusRootWidget := nil; - -end. - diff --git a/prototypes/fpgui2/source/core/gfxbase.pas b/prototypes/fpgui2/source/core/gfxbase.pas deleted file mode 100644 index 9dfb9830..00000000 --- a/prototypes/fpgui2/source/core/gfxbase.pas +++ /dev/null @@ -1,1389 +0,0 @@ -unit gfxbase; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils; - -type - TfpgCoord = integer; // we might use floating point coordinates in the future... - TfpgColor = longword; // Always in RRGGBB (Alpha, Red, Green, Blue) format!! - - TRGBTriple = record - Red: word; - Green: word; - Blue: word; - Alpha: word; - end; - - TWindowType = (wtChild, wtWindow, wtModalForm, wtPopup); - - TWindowAttribute = (waSizeable, waAutoPos, waScreenCenterPos); - TWindowAttributes = set of TWindowAttribute; - - TMouseCursor = (mcDefault, mcArrow, mcCross, mcIBeam, mcSizeEW, mcSizeNS, - mcSizeNWSE, mcSizeNESW, mcMove, mcHourGlass); - -const - MOUSE_LEFT = 1; - MOUSE_RIGHT = 2; - MOUSE_MIDDLE = 4; - - // Platform independent messages used by fpGUI (TfpgWidget) - FPGM_PAINT = 1; - FPGM_ACTIVATE = 2; - FPGM_DEACTIVATE = 3; - FPGM_KEYPRESS = 4; - FPGM_KEYRELEASE = 5; - FPGM_KEYCHAR = 6; - FPGM_MOUSEDOWN = 7; - FPGM_MOUSEUP = 8; - FPGM_MOUSEMOVE = 9; - FPGM_DOUBLECLICK = 10; - FPGM_MOUSEENTER = 11; - FPGM_MOUSEEXIT = 12; - FPGM_CLOSE = 13; - FPGM_SCROLL = 14; - FPGM_RESIZE = 15; - FPGM_MOVE = 16; - FPGM_POPUPCLOSE = 17; - FPGM_KILLME = 9999; - - // The special keys, based on the well-known keyboard scan codes - {$I keys.inc} - - FPG_DEFAULT_FONT_DESC = 'Arial-10'; - UserNamedColorStart = 128; - - {$I predefinedcolors.inc} - -type - TfpgRect = object // not class for static allocations - Top: TfpgCoord; - Left: TfpgCoord; - Width: TfpgCoord; - Height: TfpgCoord; - procedure SetRect(aleft, atop, awidth, aheight: TfpgCoord); - function Bottom: TfpgCoord; - function Right: TfpgCoord; - procedure SetBottom(Value: TfpgCoord); - procedure SetRight(Value: TfpgCoord); - end; - - - TfpgMsgParmMouse = record - x: TfpgCoord; - y: TfpgCoord; - Buttons: word; - shiftstate: TShiftState; - delta: word; - end; - - - TfpgMsgParmKeyboard = record - keycode: word; - keychar: char; - shiftstate: TShiftState; - end; - - - TfpgMessageParams = record - case integer of - 0: (mouse: TfpgMsgParmMouse); - 1: (keyboard: TfpgMsgParmKeyboard); - 2: (rect: TfpgRect); - end; - - - TfpgMessageRec = record - MsgCode: integer; - Sender: TObject; - Dest: TObject; - Params: TfpgMessageParams; - end; - PfpgMessageRec = ^TfpgMessageRec; - - - TfpgLineStyle = (lsSolid, lsDash, lsDot); - - - // forward declaration - TfpgWindowBase = class; - TfpgCanvasBase = class; - - - TfpgImageBase = class(TObject) - private - function GetColor(x, y: TfpgCoord): TfpgColor; - procedure SetColor(x, y: TfpgCoord; const AValue: TfpgColor); - protected - FWidth: integer; - FHeight: integer; - FColorDepth: integer; - FMasked: boolean; - FImageData: pointer; - FImageDataSize: integer; - FMaskData: pointer; - FMaskDataSize: integer; - procedure DoFreeImage; virtual; abstract; - procedure DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); virtual; abstract; - procedure DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); virtual; abstract; - public - constructor Create; - destructor Destroy; override; - procedure Invert; - procedure FreeImage; - procedure AllocateImage(acolordepth, awidth, aheight: integer); - procedure AllocateMask; - procedure CreateMaskFromSample(x, y: TfpgCoord); - procedure UpdateImage; - property ImageData: pointer read FImageData; - property ImageDataSize: integer read FImageDataSize; - property MaskData: pointer read FMaskData; - property MaskDataSize: integer read FMaskDataSize; - property Width: integer read FWidth; - property Height: integer read FHeight; - property ColorDepth: integer read FColorDepth; - property Masked: boolean read FMasked; - property Colors[x, y: TfpgCoord]: TfpgColor read GetColor write SetColor; - end; - - - TfpgFontResourceBase = class(TObject) - public - function GetAscent: integer; virtual; abstract; - function GetDescent: integer; virtual; abstract; - function GetHeight: integer; virtual; abstract; - function GetTextWidth(const txt: string): integer; virtual; abstract; - end; - - - TfpgFontBase = class(TObject) - protected - FFontDesc: string; - FFontRes: TfpgFontResourceBase; - public - function TextWidth(const txt: string): integer; - function Ascent: integer; - function Descent: integer; - function Height: integer; - property FontDesc: string read FFontDesc; - property FontRes: TfpgFontResourceBase read FFontRes; - property Handle: TfpgFontResourceBase read FFontRes; - end; - - - TfpgCustomInterpolation = class(TObject) - private - FCanvas: TfpgCanvasBase; - FImage: TfpgImageBase; - protected - procedure Initialize(AImage: TfpgImageBase; ACanvas: TfpgCanvasBase); virtual; - procedure Execute(x, y, w, h: integer); virtual; abstract; - public - property Canvas: TfpgCanvasBase read FCanvas; - property Image: TfpgImageBase read FImage; - end; - - - TfpgBaseInterpolation = class(TfpgCustomInterpolation) - private - xfactor: double; - yfactor: double; - xsupport: double; - ysupport: double; - tempimage: TfpgImageBase; - procedure Horizontal(width: integer); - procedure Vertical(dx, dy, width, height: integer); - protected - procedure Execute(x, y, w, h: integer); override; - function Filter(x : double): double; virtual; abstract; - function MaxSupport: double; virtual; abstract; - public - destructor Destroy; override; - end; - - - TfpgMitchelInterpolation = class(TfpgBaseInterpolation) - protected - function Filter(x: double): double; override; - function MaxSupport: double; override; - end; - - - TfpgCanvasBase = class(TObject) - private - FInterpolation: TfpgCustomInterpolation; - procedure SetInterpolation(const AValue: TfpgCustomInterpolation); - protected - FBufferedDraw: boolean; - FBeginDrawCount: integer; - FWindow: TfpgWindowBase; - FColor: TfpgColor; - FTextColor: TfpgColor; - FLineWidth: integer; - FLineStyle: TfpgLineStyle; - FFont: TfpgFontBase; - FPersistentResources: boolean; - procedure DoSetFontRes(fntres: TfpgFontResourceBase); virtual; abstract; - procedure DoSetTextColor(cl: TfpgColor); virtual; abstract; - procedure DoSetColor(cl: TfpgColor); virtual; abstract; - procedure DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); virtual; abstract; - procedure DoGetWinRect(var r: TfpgRect); virtual; abstract; - procedure DoFillRectangle(x, y, w, h: TfpgCoord); virtual; abstract; - procedure DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); virtual; abstract; - procedure DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); virtual; abstract; - procedure DoDrawRectangle(x, y, w, h: TfpgCoord); virtual; abstract; - procedure DoDrawLine(x1, y1, x2, y2: TfpgCoord); virtual; abstract; - procedure DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); virtual; abstract; - procedure DoDrawString(x, y: TfpgCoord; const txt: string); virtual; abstract; - procedure DoSetClipRect(const rect: TfpgRect); virtual; abstract; - function DoGetClipRect: TfpgRect; virtual; abstract; - procedure DoAddClipRect(const rect: TfpgRect); virtual; abstract; - procedure DoClearClipRect; virtual; abstract; - procedure DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); virtual; abstract; - procedure DoPutBufferToScreen(x, y, w, h: TfpgCoord); virtual; abstract; - procedure DoEndDraw; virtual; abstract; - function GetPixel(X, Y: integer): TfpgColor; virtual; abstract; - procedure SetPixel(X, Y: integer; const AValue: TfpgColor); virtual; abstract; - public - constructor Create; virtual; - destructor Destroy; override; - procedure DrawRectangle(x, y, w, h: TfpgCoord); overload; - procedure DrawRectangle(r: TfpgRect); overload; - procedure DrawLine(x1, y1, x2, y2: TfpgCoord); - procedure DrawImage(x, y: TfpgCoord; img: TfpgImageBase); - procedure DrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); - procedure StretchDraw (x, y, w, h: TfpgCoord; ASource: TfpgImageBase); - procedure CopyRect(x, y: TfpgCoord; ACanvas: TfpgCanvasBase; var SourceRect: TRect); - procedure DrawString(x, y: TfpgCoord; const txt: string); - procedure FillRectangle(x, y, w, h: TfpgCoord); overload; - procedure FillRectangle(r: TfpgRect); overload; - procedure FillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); - procedure XORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); overload; - procedure XORFillRectangle(col: TfpgColor; r: TfpgRect); overload; - procedure SetClipRect(const rect: TfpgRect); - function GetClipRect: TfpgRect; - procedure AddClipRect(const rect: TfpgRect); - procedure ClearClipRect; - procedure Clear(AColor: TfpgColor); - procedure GetWinRect(var r: TfpgRect); - procedure SetColor(AColor: TfpgColor); - procedure SetTextColor(AColor: TfpgColor); - procedure SetLineStyle(AWidth: integer; AStyle: TfpgLineStyle); - procedure SetFont(AFont: TfpgFontBase); - procedure BeginDraw; overload; - procedure BeginDraw(ABuffered: boolean); overload; - procedure EndDraw(x, y, w, h: TfpgCoord); overload; - procedure EndDraw; overload; - procedure FreeResources; - property Color: TfpgColor read FColor; - property TextColor: TfpgColor read FTextColor; - property Font: TfpgFontBase read FFont write SetFont; - property Pixels[X, Y: integer]: TfpgColor read GetPixel write SetPixel; - property InterpolationFilter: TfpgCustomInterpolation read FInterpolation write SetInterpolation; - end; - - - { TfpgWindowBase } - - TfpgWindowBase = class(TComponent) - private - FParent: TfpgWindowBase; - protected - FWindowType: TWindowType; - FWindowAttributes: TWindowAttributes; - FTop: TfpgCoord; - FLeft: TfpgCoord; - FWidth: TfpgCoord; - FHeight: TfpgCoord; - FMinWidth: TfpgCoord; - FMinHeight: TfpgCoord; - FCanvas: TfpgCanvasBase; - function HandleIsValid: boolean; virtual; abstract; - procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); virtual; abstract; - procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); virtual; abstract; - procedure DoReleaseWindowHandle; virtual; abstract; - procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); virtual; abstract; - function DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; virtual; abstract; - procedure DoSetWindowTitle(const ATitle: string); virtual; abstract; - procedure SetParent(const AValue: TfpgWindowBase); virtual; - function GetParent: TfpgWindowBase; virtual; - function GetCanvas: TfpgCanvasBase; virtual; - procedure AllocateWindowHandle; - procedure ReleaseWindowHandle; - procedure SetWindowTitle(const ATitle: string); virtual; - public - // make some setup before the window shows - procedure AdjustWindowStyle; virtual; // forms modify the window creation parameters - procedure SetWindowParameters; virtual; // invoked after the window is created - // general properties and functions - function Right: TfpgCoord; - function Bottom: TfpgCoord; - procedure UpdateWindowPosition; - procedure MoveWindow(const x: TfpgCoord; const y: TfpgCoord); - function WindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; - procedure CaptureMouse; virtual; abstract; - procedure ReleaseMouse; virtual; abstract; - property HasHandle: boolean read HandleIsValid; - property WindowType: TWindowType read FWindowType write FWindowType; - property WindowAttributes: TWindowAttributes read FWindowAttributes write FWindowAttributes; - property Left: TfpgCoord read FLeft write FLeft; - property Top: TfpgCoord read FTop write FTop; - property Width: TfpgCoord read FWidth write FWidth; - property Height: TfpgCoord read FHeight write FHeight; - property MinWidth: TfpgCoord read FMinWidth write FMinWidth; - property MinHeight: TfpgCoord read FMinHeight write FMinHeight; - property Canvas: TfpgCanvasBase read GetCanvas; - property Parent: TfpgWindowBase read GetParent write SetParent; - end; - - - TfpgApplicationBase = class(TObject) - protected - FIsInitialized: Boolean; - public - constructor Create(const AParams: string); virtual; abstract; - property IsInitialized: boolean read FIsInitialized; - end; - - -{ ******** Helper functions ******** } -{ Keyboard } -function KeycodeToText(AKey: Word; AShiftState: TShiftState): string; - -{ Color } -function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; -function RGBTripleTofpgColor(const AColor: TRGBTriple): TfpgColor; -function fpgGetRed(const AColor: TfpgColor): word; -function fpgGetGreen(const AColor: TfpgColor): word; -function fpgGetBlue(const AColor: TfpgColor): word; -function fpgGetAlpha(const AColor: TfpgColor): word; - -{ Points } -function PtInRect(const ARect: TfpgRect; const APoint: TPoint): Boolean; -procedure SortRect(var ARect: TRect); -procedure SortRect(var left, top, right, bottom: integer); - -implementation - -uses - fpgfx; // needed for fpgApplication - - -function KeycodeToText(AKey: Word; AShiftState: TShiftState): string; - - function GetASCIIText: String; - var - c: Char; - begin - result := ''; - c := Chr(AKey and $ff); - case c of - #13: Result := Result + 'Enter'; - #127: Result := Result + 'Del'; - '+': Result := Result + 'Plus' - else - Result := Result + c; - end; - end; - -var - s: String; -begin - SetLength(Result, 0); - - if ssShift in AShiftState then - Result := 'Shift+'; - if ssCtrl in AShiftState then - Result := 'Ctrl+'; - if ssAlt in AShiftState then - Result := 'Alt+'; - - if (AKey > Ord(' ')) and (AKey < 255) then - begin - Result := Result + GetASCIIText; - Exit; //==> - end; - - case AKey of - keyNul: s := 'Null'; - keyBackSpace: s := 'Backspace'; - keyTab: s := 'Tab'; - keyLinefeed: s := 'Linefeed'; - keyReturn: s := 'Enter'; - keyEscape: s := 'Esc'; - Ord(' '): s := 'Space'; - keyDelete: s := 'Del'; - keyVoid: s := 'Void'; - keyBreak: s := 'Break'; - keyScrollForw: s := 'ScrollForw'; - keyScrollBack: s := 'ScrollBack'; - keyBoot: s := 'Boot'; - keyCompose: s := 'Compose'; - keySAK: s := 'SAK'; - keyUndo: s := 'Undo'; - keyRedo: s := 'Redo'; - keyMenu: s := 'Menu'; - keyCancel: s := 'Cancel'; - keyPrintScreen: s := 'PrtScr'; - keyExecute: s := 'Exec'; - keyFind: s := 'Find'; - keyBegin: s := 'Begin'; - keyClear: s := 'Clear'; - keyInsert: s := 'Ins'; - keySelect: s := 'Select'; - keyMacro: s := 'Macro'; - keyHelp: s := 'Help'; - keyDo: s := 'Do'; - keyPause: s := 'Pause'; - keySysRq: s := 'SysRq'; - keyModeSwitch: s := 'ModeSw'; - keyUp: s := 'Up'; - keyDown: s := 'Down'; - keyLeft: s := 'Left'; - keyRight: s := 'Right'; - keyPrior: s := 'PgUp'; - keyNext: s := 'PgDown'; - keyHome: s := 'Home'; - keyEnd: s := 'End'; - keyF0..keyF64: s := 'F' + IntToStr(AKey - keyF0); - keyP0..keyP9: s := 'KP' + Chr(AKey - keyP0 + Ord('0')); - keyPA..keyPF: s := 'KP' + Chr(AKey - keyPA + Ord('A')); - keyPPlus, keyPMinus, keyPSlash, keyPStar, keyPEqual, keyPSeparator, - keyPDecimal, keyPParenLeft, keyPParenRight, keyPSpace, keyPEnter, - keyPTab: s := 'KP' + GetASCIIText; - keyPPlusMinus: s := 'KPPlusMinus'; - keyPBegin: s := 'KPBegin'; - keyPF1..keyPF9: s := 'KPF' + IntToStr(AKey - keyPF1); - keyShiftL: s := 'ShiftL'; - keyShiftR: s := 'ShiftR'; - keyCtrlL: s := 'CtrlL'; - keyCtrlR: s := 'CtrlR'; - keyAltL: s := 'AltL'; - keyAltR: s := 'AltR'; - keyMetaL: s := 'MetaL'; - keyMetaR: s := 'MetaR'; - keySuperL: s := 'SuperL'; - keySuperR: s := 'SuperR'; - keyHyperL: s := 'HyperL'; - keyHyperR: s := 'HyperR'; - keyAltGr: s := 'AltGr'; - keyCaps: s := 'Caps'; - keyNum: s := 'Num'; - keyScroll: s := 'Scroll'; - keyShiftLock: s := 'ShiftLock'; - keyCtrlLock: s := 'CtrlLock'; - keyAltLock: s := 'AltLock'; - keyMetaLock: s := 'MetaLock'; - keySuperLock: s := 'SuperLock'; - keyHyperLock: s := 'HyperLock'; - keyAltGrLock: s := 'AltGrLock'; - keyCapsLock: s := 'CapsLock'; - keyNumLock: s := 'NumLock'; - keyScrollLock: s := 'ScrollLock'; - keyDeadRing: s := 'DeadRing'; - keyDeadCaron: s := 'DeadCaron'; - keyDeadOgonek: s := 'DeadOgonek'; - keyDeadIota: s := 'DeadIota'; - keyDeadDoubleAcute: s := 'DeadDoubleAcute'; - keyDeadBreve: s := 'DeadBreve'; - keyDeadAboveDot: s := 'DeadAboveDot'; - keyDeadBelowDot: s := 'DeadBelowDot'; - keyDeadVoicedSound: s := 'DeadVoicedSound'; - keyDeadSemiVoicedSound: s := 'DeadSemiVoicedSound'; - keyDeadAcute: s := 'DeadAcute'; - keyDeadCedilla: s := 'DeadCedilla'; - keyDeadCircumflex: s := 'DeadCircumflex'; - keyDeadDiaeresis: s := 'DeadDiaeresis'; - keyDeadGrave: s := 'DeadGrave'; - keyDeadTilde: s := 'DeadTilde'; - keyDeadMacron: s := 'DeadMacron'; - - keyEcuSign: s := 'Ecu'; - keyColonSign: s := 'Colon'; - keyCruzeiroSign: s := 'Cruzeiro'; - keyFFrancSign: s := 'FFranc'; - keyLiraSign: s := 'Lira'; - keyMillSign: s := 'Mill'; - keyNairaSign: s := 'Naira'; - keyPesetaSign: s := 'Peseta'; - keyRupeeSign: s := 'Rupee'; - keyWonSign: s := 'Won'; - keyNewSheqelSign: s := 'NewShequel'; - keyDongSign: s := 'Dong'; - keyEuroSign: s := 'Euro'; - else - s := '#' + IntToHex(AKey, 4); - end; - Result := Result + s; -end; - -function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; -begin - with Result do - begin - Red := fpgGetRed(AColor); - Green := fpgGetGreen(AColor); - Blue := fpgGetBlue(AColor); -// Alpha := fpgGetAlpha(AColor); - end -end; - -function RGBTripleTofpgColor(const AColor: TRGBTriple): TfpgColor; -begin - Result := AColor.Blue or (AColor.Green shl 8) or (AColor.Red shl 16);// or (AColor.Alpha shl 32); -end; - -function fpgGetRed(const AColor: TfpgColor): word; -begin - // AARRGGBB format - Result := Word((AColor shr 16) and $FF); -end; - -function fpgGetGreen(const AColor: TfpgColor): word; -begin - // AARRGGBB format - Result := Word((AColor shr 8) and $FF); -end; - -function fpgGetBlue(const AColor: TfpgColor): word; -begin - // AARRGGBB format - Result := Word(AColor and $FF); -end; - -function fpgGetAlpha(const AColor: TfpgColor): word; -begin - // AARRGGBB format - Result := Word((AColor shr 32) and $FF); -end; - -function PtInRect(const ARect: TfpgRect; const APoint: TPoint): Boolean; -begin - Result := (APoint.x >= ARect.Left) and - (APoint.y >= ARect.Top) and - (APoint.x < ARect.Right) and - (APoint.y < ARect.Bottom); -end; - -procedure SortRect(var ARect: TRect); -begin - with ARect do - SortRect(left, top, right, bottom); -end; - -procedure SortRect(var left, top, right, bottom: integer); -var - r: integer; -begin - if left > right then - begin - r := left; - left := right; - right := r; - end; - if top > bottom then - begin - r := top; - top := bottom; - bottom := r; - end; -end; - -{ TfpgRect } - -procedure TfpgRect.SetRect(aleft, atop, awidth, aheight: TfpgCoord); -begin - Left := aleft; - Top := atop; - Width := awidth; - Height := aheight; -end; - -function TfpgRect.Bottom: TfpgCoord; -begin - Result := Top + Height - 1; -end; - -function TfpgRect.Right: TfpgCoord; -begin - Result := Left + Width - 1; -end; - -procedure TfpgRect.SetBottom(Value: TfpgCoord); -begin - Height := Value - Top + 1; -end; - -procedure TfpgRect.SetRight(Value: TfpgCoord); -begin - Width := Value - Left + 1; -end; - -{ TfpgWindowBase } - -procedure TfpgWindowBase.SetParent(const AValue: TfpgWindowBase); -begin - FParent := AValue; -end; - -function TfpgWindowBase.GetParent: TfpgWindowBase; -begin - result := FParent; -end; - -function TfpgWindowBase.GetCanvas: TfpgCanvasBase; -begin - Result := FCanvas; -end; - -procedure TfpgWindowBase.AllocateWindowHandle; -begin - DoAllocateWindowHandle(FParent); -end; - -procedure TfpgWindowBase.ReleaseWindowHandle; -begin - if HasHandle then - begin - Canvas.FreeResources; - DoReleaseWindowHandle; - end; -end; - -procedure TfpgWindowBase.SetWindowTitle(const ATitle: string); -begin - DoSetWindowTitle(ATitle); -end; - -procedure TfpgWindowBase.AdjustWindowStyle; -begin - // does nothing here -end; - -procedure TfpgWindowBase.SetWindowParameters; -begin - // does nothing -end; - -function TfpgWindowBase.Right: TfpgCoord; -begin - Result := FLeft + FWidth - 1; -end; - -function TfpgWindowBase.Bottom: TfpgCoord; -begin - Result := FTop + FHeight - 1; -end; - -procedure TfpgWindowBase.UpdateWindowPosition; -begin - if HasHandle then - DoUpdateWindowPosition(FLeft, FTop, FWidth, FHeight); -end; - -procedure TfpgWindowBase.MoveWindow(const x: TfpgCoord; const y: TfpgCoord); -begin - DoMoveWindow(x, y); -end; - -function TfpgWindowBase.WindowToScreen(ASource: TfpgWindowBase; - const AScreenPos: TPoint): TPoint; -begin - Result := DoWindowToScreen(ASource, AScreenPos); -end; - -{ TfpgCanvasBase } - -procedure TfpgCanvasBase.SetInterpolation(const AValue: TfpgCustomInterpolation); -begin - FInterpolation.Free; - FInterpolation := AValue; -end; - -constructor TfpgCanvasBase.Create; -begin - FBufferedDraw := True; -end; - -destructor TfpgCanvasBase.Destroy; -begin - FInterpolation.Free; - inherited Destroy; -end; - -procedure TfpgCanvasBase.DrawRectangle(x, y, w, h: TfpgCoord); -begin - DoDrawRectangle(x, y, w, h); -end; - -procedure TfpgCanvasBase.DrawRectangle(r: TfpgRect); -begin - DoDrawRectangle(r.Left, r.Top, r.Width, r.Height); -end; - -procedure TfpgCanvasBase.DrawLine(x1, y1, x2, y2: TfpgCoord); -begin - DoDrawLine(x1, y1, x2, y2); -end; - -procedure TfpgCanvasBase.DrawImage(x, y: TfpgCoord; img: TfpgImageBase); -begin - if img = nil then - Exit; //==> - DrawImagePart(x, y, img, 0, 0, img.Width, img.Height); -end; - -procedure TfpgCanvasBase.DrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, - yi, w, h: integer); -begin - DoDrawImagePart(x, y, img, xi, yi, w, h); -end; - -procedure TfpgCanvasBase.StretchDraw(x, y, w, h: TfpgCoord; ASource: TfpgImageBase); -var - i: TfpgCustomInterpolation; - FreeInterpolation: boolean; - IP: TfpgCustomInterpolation; -begin - FreeInterpolation := not Assigned(FInterpolation); - if FreeInterpolation then - IP := TfpgMitchelInterpolation.Create - else - IP := FInterpolation; - try - IP.Initialize(ASource, self); - IP.Execute(x, y, w, h); - finally - if FreeInterpolation then - IP.Free; - end; -end; - -procedure TfpgCanvasBase.CopyRect(x, y: TfpgCoord; ACanvas: TfpgCanvasBase; - var SourceRect: TRect); -var - xx, r, t: TfpgCoord; -begin - SortRect(SourceRect); - with SourceRect do - for r := left to right do - begin - xx := r - left + x; - for t := bottom to top do - Pixels[xx, (t - bottom + y)] := ACanvas.Pixels[r, t]; - end; -end; - -procedure TfpgCanvasBase.DrawString(x, y: TfpgCoord; const txt: string); -var - underline: integer; -begin - DoDrawString(x, y, txt); - - { What was not handled: underline } - if Pos('UNDERLINE', UpperCase(Font.FontDesc)) > 0 then - begin - underline := (Font.Descent div 2) + 1; - if underline = 0 then - underline := 1; - if underline >= Font.Descent then - underline := Font.Descent - 1; - -// if Pos('BOLD', UpperCase(Font.FontDesc)) = 0 then - DoSetLineStyle(1, lsSolid); -// else -// DoSetLineStyle(2, lsSolid); - DoSetColor(TextColor); - DoDrawLine(x, Font.Height-underline, x+Font.TextWidth(txt), Font.Height-underline); - end; -end; - -procedure TfpgCanvasBase.FillRectangle(x, y, w, h: TfpgCoord); -begin - DoFillRectangle(x, y, w, h); -end; - -procedure TfpgCanvasBase.FillRectangle(r: TfpgRect); -begin - DoFillRectangle(r.Left, r.Top, r.Width, r.Height); -end; - -procedure TfpgCanvasBase.FillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); -begin - DoFillTriangle(x1, y1, x2, y2, x3, y3); -end; - -procedure TfpgCanvasBase.XORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); -begin - DoXORFillRectangle(col, x, y, w, h); -end; - -procedure TfpgCanvasBase.XORFillRectangle(col: TfpgColor; r: TfpgRect); -begin - DoXORFillRectangle(col, r.Left, r.Top, r.Width, r.Height); -end; - -procedure TfpgCanvasBase.SetClipRect(const rect: TfpgRect); -begin - DoSetClipRect(rect); -end; - -function TfpgCanvasBase.GetClipRect: TfpgRect; -begin - Result := DoGetClipRect; -end; - -procedure TfpgCanvasBase.AddClipRect(const rect: TfpgRect); -begin - DoAddClipRect(rect); -end; - -procedure TfpgCanvasBase.ClearClipRect; -begin - DoClearClipRect; -end; - -procedure TfpgCanvasBase.Clear(AColor: TfpgColor); -var - lCol: TfpgColor; - lWinRect: TfpgRect; -begin - lCol := FColor; - DoSetColor(AColor); - DoGetWinRect(lWinRect); - DoFillRectangle(0, 0, lWinRect.Width, lWinRect.Height); - DoSetColor(lCol); -end; - -procedure TfpgCanvasBase.GetWinRect(var r: TfpgRect); -begin - DoGetWinRect(r); -end; - -procedure TfpgCanvasBase.SetColor(AColor: TfpgColor); -begin - FColor := AColor; - DoSetColor(FColor); -end; - -procedure TfpgCanvasBase.SetTextColor(AColor: TfpgColor); -begin - FTextColor := AColor; - DoSetTextColor(FTextColor); -end; - -procedure TfpgCanvasBase.SetLineStyle(AWidth: integer; AStyle: TfpgLineStyle); -begin - FLineWidth := AWidth; - FLineStyle := AStyle; - DoSetLineStyle(FLineWidth, FLineStyle); -end; - -procedure TfpgCanvasBase.SetFont(AFont: TfpgFontBase); -begin - FFont := AFont; - DoSetFontRes(AFont.FFontRes); -end; - -procedure TfpgCanvasBase.BeginDraw; -begin - BeginDraw(FBufferedDraw); -end; - -procedure TfpgCanvasBase.BeginDraw(ABuffered: boolean); -begin - if FBeginDrawCount < 1 then - begin - DoBeginDraw(FWindow, ABuffered); - - SetColor(clText1); - SetTextColor(clText1); - SetFont(fpgApplication.DefaultFont); - SetLineStyle(0, lsSolid); - - FBeginDrawCount := 0; - end; - Inc(FBeginDrawCount); -end; - -procedure TfpgCanvasBase.EndDraw(x, y, w, h: TfpgCoord); -begin - if FBeginDrawCount > 0 then - begin - Dec(FBeginDrawCount); - if FBeginDrawCount = 0 then - begin - DoPutBufferToScreen(x, y, w, h); - - if not FPersistentResources then - DoEndDraw; - end; - end; { if } -end; - -procedure TfpgCanvasBase.EndDraw; -begin - EndDraw(0, 0, FWindow.Width, FWindow.Height); -end; - -procedure TfpgCanvasBase.FreeResources; -begin - DoEndDraw; - FBeginDrawCount := 0; -end; - -{ TfpgFontBase } - -function TfpgFontBase.TextWidth(const txt: string): integer; -begin - Result := FFontRes.GetTextWidth(txt); -end; - -function TfpgFontBase.Ascent: integer; -begin - Result := FFontRes.GetAscent; -end; - -function TfpgFontBase.Descent: integer; -begin - Result := FFontRes.GetDescent; -end; - -function TfpgFontBase.Height: integer; -begin - Result := FFontRes.GetHeight; -end; - -{ TfpgCustomInterpolation } - -procedure TfpgCustomInterpolation.Initialize(AImage: TfpgImageBase; - ACanvas: TfpgCanvasBase); -begin - FImage := AImage; - FCanvas := ACanvas; -end; - -{ TfpgBaseInterpolation } - -type - TfpgInterpolationContribution = record - weight: double; - place: integer; - end; - -function ColorRound(c: double): word; -begin - if c > $FFFF then - result := $FFFF - else if c < 0.0 then - result := 0 - else - result := round(c); -end; - - -procedure TfpgBaseInterpolation.Horizontal(width: integer); -var - x, y, r: integer; - start, stop, maxcontribs: integer; - center, re, gr, bl, density: double; - contributions: array[0..10] of TfpgInterpolationContribution; - dif, w, gamma, a: double; - c: TfpgColor; - rgb: TRGBTriple; -begin - for x := 0 to Width - 1 do - begin - center := x * xfactor; - start := round(center - xsupport); - if start < 0 then - start := 0; - stop := round(center + xsupport); - if stop >= image.Width then - stop := image.Width - 1; - density := 0.0; - maxcontribs := -1; - for r := start to stop do - begin - dif := r - center; - w := Filter(dif); - if w > 0.0 then - begin - Inc(maxcontribs); - with contributions[maxcontribs] do - begin - weight := w; - density := density + w; - place := r; - end; - end; - end; - if (density <> 0.0) and (density <> 1.0) then - begin - density := 1.0 / density; - for r := 0 to maxcontribs do - contributions[r].weight := contributions[r].weight * density; - end; - for y := 0 to image.Height - 1 do - begin - gamma := 0.0; - re := 0.0; - gr := 0.0; - bl := 0.0; - for r := 0 to maxcontribs do - with contributions[r] do - begin - c := image.colors[place, y]; - rgb := fpgColorToRGBTriple(c); - a := weight; // * rgb.Alpha / $FFFF; - re := re + a * rgb.Red; - gr := gr + a * rgb.Green; - bl := bl + a * rgb.Blue; - gamma := gamma + a; - end; { with } - with rgb do - begin - red := ColorRound(re); - green := ColorRound(gr); - blue := ColorRound(bl); -// alpha := ColorRound(gamma * $FFFF); - end; - tempimage.colors[x, y] := RGBTripleTofpgColor(rgb); - end; - end; -end; - -procedure TfpgBaseInterpolation.Vertical(dx, dy, width, height: integer); -var - x, y, r: integer; - start, stop, maxcontribs: integer; - center, re, gr, bl, density: double; - contributions: array[0..10] of TfpgInterpolationContribution; - dif, w, gamma, a: double; - c: TfpgColor; - rgb: TRGBTriple; -begin - for y := 0 to Height - 1 do - begin - center := y * yfactor; - start := round(center - ysupport); - if start < 0 then - start := 0; - stop := round(center + ysupport); - if stop >= tempimage.Height then - stop := tempimage.Height - 1; - density := 0.0; - maxcontribs := -1; - for r := start to stop do - begin - dif := r - center; - w := Filter(dif); - if w > 0.0 then - begin - Inc(maxcontribs); - with contributions[maxcontribs] do - begin - weight := w; - density := density + w; - place := r; - end; - end; - end; - if (density <> 0.0) and (density <> 1.0) then - begin - density := 1.0 / density; - for r := 0 to maxcontribs do - contributions[r].weight := contributions[r].weight * density; - end; - for x := 0 to Width - 1 do - begin - gamma := 0.0; - re := 0.0; - gr := 0.0; - bl := 0.0; - for r := 0 to maxcontribs do - with contributions[r] do - begin - c := tempimage.colors[x, place]; - rgb := fpgColorToRGBTriple(c); - a := weight;// * rgb.alpha / $FFFF; - re := re + a * rgb.red; - gr := gr + a * rgb.green; - bl := bl + a * rgb.blue; - gamma := gamma + a; - end; { width } - with rgb do - begin - red := ColorRound(re); - green := ColorRound(gr); - blue := ColorRound(bl); -// alpha := ColorRound(gamma * $FFFF); - end; - Canvas.Pixels[x + dx, y + dy] := RGBTripleTofpgColor(rgb); - end; - end; -end; - -procedure TfpgBaseInterpolation.Execute(x, y, w, h: integer); -var - maxy: integer; - rx, ry: integer; -begin - tempimage := TfpgImageBase.Create; - tempimage.AllocateImage(image.ColorDepth, w, image.Height); - - xfactor := image.Width / w; - yfactor := image.Height / h; - if xfactor > 1.0 then - xsupport := MaxSupport - else - xsupport := xfactor * MaxSupport; - if yfactor > 1.0 then - ysupport := MaxSupport - else - ysupport := yfactor * MaxSupport; - Horizontal(w); - Vertical(x, y, w, h); -end; - -destructor TfpgBaseInterpolation.Destroy; -begin - tempimage.Free; - inherited Destroy; -end; - -{ TfpgImageBase } - -function TfpgImageBase.GetColor(x, y: TfpgCoord): TfpgColor; -var - p: Plongword; -begin - p := FImageData; - Inc(p, (FWidth * y) + x); - Result := TfpgColor(p^); -// write(IntToHex(Result, 6) + ' '); -end; - -procedure TfpgImageBase.SetColor(x, y: TfpgCoord; const AValue: TfpgColor); -var - p: Plongword; -begin - p := FImageData; - Inc(p, (FWidth * y) + x); - p^ := longword(AValue); -// write(IntToHex(AValue, 6) + ' '); -end; - -constructor TfpgImageBase.Create; -begin - FWidth := 0; - FHeight := 0; - FColorDepth := 0; - - FImageData := nil; - FImageDataSize := 0; - FMaskData := nil; - FMaskDataSize := 0; - FMasked := False; -end; - -destructor TfpgImageBase.Destroy; -begin - FreeImage; - inherited Destroy; -end; - -procedure TfpgImageBase.Invert; -var - p: ^byte; - n: integer; -begin - if FImageData = nil then - Exit; //==> - - p := FImageData; - for n := 1 to FImageDataSize do - begin - p^ := p^ xor $FF; - Inc(p); - end; - - if FMaskData <> nil then - begin - p := FMaskData; - for n := 1 to FMaskDataSize do - begin - p^ := p^ xor $FF; - Inc(p); - end; - end; -end; - -procedure TfpgImageBase.FreeImage; -begin - if FImageData <> nil then - FreeMem(FImageData); - FImageData := nil; - FImageDataSize := 0; - if FMaskData <> nil then - FreeMem(FMaskData); - FMaskData := nil; - FMaskDataSize := 0; - FMasked := False; - FWidth := 0; - FHeight := 0; -// DoFreeImage; -end; - -procedure TfpgImageBase.AllocateImage(acolordepth, awidth, aheight: integer); -var - dww: integer; -begin - FreeImage; - FWidth := awidth; - FHeight := aheight; - FColorDepth := acolordepth; - - // Real bitmap - if FColorDepth = 1 then - dww := (awidth + 31) div 32 - else - dww := FWidth; - - FImageDataSize := dww * FHeight * 4; - GetMem(FImageData, FImageDataSize); -end; - -procedure TfpgImageBase.AllocateMask; -var - dww: integer; -begin - if (FWidth < 1) or (FHeight < 1) then - Exit; //==> - - FMasked := True; - if FMaskData <> nil then - FreeMem(FMaskData); - - dww := (FWidth + 31) div 32; - FMaskDataSize := dww * FHeight * 4; - GetMem(FMaskData, FMaskDataSize); -end; - -procedure TfpgImageBase.CreateMaskFromSample(x, y: TfpgCoord); -var - p: ^longword; - pmsk: ^byte; - c: longword; - linecnt: integer; - pixelcnt: integer; - bit: byte; - msklinelen: integer; -begin - if FColorDepth = 1 then - Exit; //==> - - if (FImageData = nil) then - Exit; //==> - - AllocateMask; - - p := FImageData; - if x < 0 then - Inc(p, FWidth - 1) - else - Inc(p, x); - if y < 0 then - Inc(p, FWidth * (FHeight - 1)) - else - Inc(p, FWidth * y); - - c := p^; // the sample - - msklinelen := FWidth div 32; - if (FWidth and $1F) > 0 then - Inc(msklinelen); - - msklinelen := msklinelen shl 2; - - p := FImageData; - linecnt := 0; - - repeat - pixelcnt := 0; - bit := $80; - pmsk := FMaskData; - Inc(pmsk, linecnt * msklinelen); - - repeat - if bit = $80 then - pmsk^ := 0; - - if p^ <> c then - pmsk^ := pmsk^ or bit; - - Inc(p); - Inc(pixelcnt); - - if bit = 1 then - begin - bit := $80; - Inc(pmsk); - end - else - bit := bit shr 1; - until pixelcnt >= FWidth; - - Inc(linecnt); - until linecnt >= FHeight; -end; - -procedure TfpgImageBase.UpdateImage; -begin - if FImageData <> nil then - DoInitImage(FColorDepth, FWidth, FHeight, FImageData); - - if FMaskData <> nil then - DoInitImageMask(FWidth, FHeight, FMaskData); -end; - -{ TfpgMitchelInterpolation } - -function TfpgMitchelInterpolation.Filter(x: double): double; -const - B = (1.0/3.0); - C = (1.0/3.0); - P0 = (( 6.0- 2.0*B )/6.0); - P2 = ((-18.0+12.0*B+ 6.0*C)/6.0); - P3 = (( 12.0- 9.0*B- 6.0*C)/6.0); - Q0 = (( 8.0*B+24.0*C)/6.0); - Q1 = (( -12.0*B-48.0*C)/6.0); - Q2 = (( 6.0*B+30.0*C)/6.0); - Q3 = (( - 1.0*B- 6.0*C)/6.0); -begin - if (x < -2.0) then - result := 0.0 - else if (x < -1.0) then - result := Q0-x*(Q1-x*(Q2-x*Q3)) - else if (x < 0.0) then - result := P0+x*x*(P2-x*P3) - else if (x < 1.0) then - result := P0+x*x*(P2+x*P3) - else if (x < 2.0) then - result := Q0+x*(Q1+x*(Q2+x*Q3)) - else - result := 0.0; -end; - -function TfpgMitchelInterpolation.MaxSupport: double; -begin - result := 2.0; -end; - -end. - diff --git a/prototypes/fpgui2/source/core/gfxbaseinterfaces.pas b/prototypes/fpgui2/source/core/gfxbaseinterfaces.pas deleted file mode 100644 index 1a3f28ff..00000000 --- a/prototypes/fpgui2/source/core/gfxbaseinterfaces.pas +++ /dev/null @@ -1,25 +0,0 @@ -unit gfxbaseinterfaces; - -{$mode objfpc}{$H+} - -interface - -uses - Classes; - -type - // forward declarations - IGFXWindow = interface; - - - IGFXWindow = interface(IInterface) - ['{45964C7E-A7E9-4915-9EA1-3F26C5C55A2F}'] - procedure DoAllocateWindowHandle(AParent: IGFXWindow); - procedure DoSetWindowTitle(const ATitle: string); - end; - - -implementation - -end. - diff --git a/prototypes/fpgui2/source/core/keys.inc b/prototypes/fpgui2/source/core/keys.inc deleted file mode 100644 index 832a6a16..00000000 --- a/prototypes/fpgui2/source/core/keys.inc +++ /dev/null @@ -1,253 +0,0 @@ -{ - We use GGI's key definitions; the names just - have been somewhat pascalified... - GGI info at <http://www.ggi-project.org> - GII info at <http://www.ggi-project.org/packages/libgii.html> -} - -const - - // ASCII keys - - keyNul = $00; - keyBackSpace = $08; - keyTab = $09; - keyLinefeed = $0a; - keyReturn = $0d; - keyEscape = $1b; - keyDelete = $7f; - keySpace = $20; - - // special keys - - keyVoid = $e000; - keyBreak = $e005; - keyScrollForw = $e00a; - keyScrollBack = $e00b; - keyBoot = $e00c; - keyCompose = $e00e; - keySAK = $e00f; - keyUndo = $e017; - keyRedo = $e018; - keyMenu = $e019; - keyCancel = $e01a; - keyPrintScreen = $e01b; - keyExecute = $e01c; - keyFind = $e01e; - keyBegin = $e01f; - keyClear = $e020; - keyInsert = $e022; - keySelect = $e023; - keyMacro = $e026; - keyHelp = $e027; - keyDo = $e028; - keyPause = $e029; - keyStop = keyPause; - keySysRq = $e02a; - keyModeSwitch = $e02b; - keyUp = $e032; - keyDown = $e033; - keyLeft = $e034; - keyRight = $e035; - keyPrior = $e036; - keyPageUp = keyPrior; - keyNext = $e037; - keyPageDown = keyNext; - keyHome = $e038; - keyEnd = $e039; - - - // function keys - - keyF0 = $e100; - keyF1 = $e101; - keyF2 = $e102; - keyF3 = $e103; - keyF4 = $e104; - keyF5 = $e105; - keyF6 = $e106; - keyF7 = $e107; - keyF8 = $e108; - keyF9 = $e109; - keyF10 = $e10a; - keyF11 = $e10b; - keyF12 = $e10c; - keyF13 = $e10d; - keyF14 = $e10e; - keyF15 = $e10f; - keyF16 = $e110; - keyF17 = $e111; - keyF18 = $e112; - keyF19 = $e113; - keyF20 = $e114; - keyF21 = $e115; - keyF22 = $e116; - keyF23 = $e117; - keyF24 = $e118; - keyF25 = $e119; - keyF26 = $e11a; - keyF27 = $e11b; - keyF28 = $e11c; - keyF29 = $e11d; - keyF30 = $e11e; - keyF31 = $e11f; - keyF32 = $e120; - keyF33 = $e121; - keyF34 = $e122; - keyF35 = $e123; - keyF36 = $e124; - keyF37 = $e125; - keyF38 = $e126; - keyF39 = $e127; - keyF40 = $e128; - keyF41 = $e129; - keyF42 = $e12a; - keyF43 = $e12b; - keyF44 = $e12c; - keyF45 = $e12d; - keyF46 = $e12e; - keyF47 = $e12f; - keyF48 = $e130; - keyF49 = $e131; - keyF50 = $e132; - keyF51 = $e133; - keyF52 = $e134; - keyF53 = $e135; - keyF54 = $e136; - keyF55 = $e137; - keyF56 = $e138; - keyF57 = $e139; - keyF58 = $e13a; - keyF59 = $e13b; - keyF60 = $e13c; - keyF61 = $e13d; - keyF62 = $e13e; - keyF63 = $e13f; - keyF64 = $e140; - - - // keys on the numeric keypad - keyP0 = $e230; - keyP1 = $e231; - keyP2 = $e232; - keyP3 = $e233; - keyP4 = $e234; - keyP5 = $e235; - keyP6 = $e236; - keyP7 = $e237; - keyP8 = $e238; - keyP9 = $e239; - keyPA = $e241; - keyPB = $e242; - keyPC = $e243; - keyPD = $e244; - keyPE = $e245; - keyPF = $e246; - keyPPlus = $e200 + Ord('+'); - keyPMinus = $e200 + Ord('-'); - keyPSlash = $e200 + Ord('/'); - keyPAsterisk = $e200 + Ord('*'); - keyPStar = keyPAsterisk; - keyPEqual = $e200 + Ord('='); - keyPSeparator = $e200 + Ord(','); - keyPDecimal = $e200 + Ord('.'); - keyPParenLeft = $e200 + Ord('('); - keyPParenRight = $e200 + Ord(')'); - keyPSpace = $e200 + Ord(' '); - keyPEnter = $e20d; - keyPTab = $e208; - keyPPlusMinus = $e280; - keyPBegin = $e281; - keyPF1 = $e291; - keyPF2 = $e292; - keyPF3 = $e293; - keyPF4 = $e294; - keyPF5 = $e295; - keyPF6 = $e296; - keyPF7 = $e297; - keyPF8 = $e298; - keyPF9 = $e299; - - - // modifier keys - - keyShift = $e300; - keyCtrl = $e301; - keyAlt = $e302; - keyMeta = $e303; - keySuper = $e304; - keyHyper = $e305; - keyAltGr = $e306; - keyCaps = $e307; - keyNum = $e308; - keyScroll = $e309; - - - // modifier _labels_ - - keyShiftL = $e300; - keyShiftR = $e340; - keyCtrlL = $e301; - keyCtrlR = $e341; - keyAltL = $e302; - keyAltR = $e342; - keyMetaL = $e303; - keyMetaR = $e343; - keySuperL = $e304; - keySuperR = $e344; - keyHyperL = $e305; - keyHyperR = $e345; - keyShiftLock = $e380; - keyCtrlLock = $e381; - keyAltLock = $e382; - keyMetaLock = $e383; - keySuperLock = $e384; - keyHyperLock = $e385; - keyAltGrLock = $e386; - keyCapsLock = $e387; - keyNumLock = $e388; - keyScrollLock = $e389; - - // Dead keys - keyDeadRing = $e400; - keyDeadCaron = $e401; - keyDeadOgonek = $e402; - keyDeadIota = $e403; - keyDeadDoubleAcute = $e404; - keyDeadBreve = $e405; - keyDeadAboveDot = $e406; - keyDeadBelowDot = $e407; - keyDeadVoicedSound = $e408; - keyDeadSemiVoicedSound = $e409; - - - keyDeadAcute = $e4b4; - keyDeadCedilla = $e4b8; - keyDeadCircumflex = $e45e; - keyDeadDiaeresis = $e4a8; - keyDeadGrave = $e460; - keyDeadTilde = $e47e; - keyDeadMacron = $e4af; - - // miscellaneous - keyNIL = $ffff; // used to indicate "not mapped yet" - - - // currencies (NOTE: These values are not defined in GGI/GII! - // !!!: Check if GII has got currency codes in the meantime - keyEcuSign = $e500; - keyColonSign = $e501; - keyCruzeiroSign = $e502; - keyFFrancSign = $e503; - keyLiraSign = $e504; - keyMillSign = $e505; - keyNairaSign = $e506; - keyPesetaSign = $e507; - keyRupeeSign = $e508; - keyWonSign = $e509; - keyNewSheqelSign = $e50a; - keyDongSign = $e50b; - keyEuroSign = $e50c; - - - diff --git a/prototypes/fpgui2/source/core/predefinedcolors.inc b/prototypes/fpgui2/source/core/predefinedcolors.inc deleted file mode 100644 index 5162a58e..00000000 --- a/prototypes/fpgui2/source/core/predefinedcolors.inc +++ /dev/null @@ -1,211 +0,0 @@ - - - // The following colors match the predefined Delphi Colors - // NOTE: - // The format is always RRGGBB (Red, Green, Blue); - - clAqua = TfpgColor($00FFFF); - clBlack = TfpgColor($000000); - clBlue = TfpgColor($0000FF); - clCream = TfpgColor($FFFBF0); - clDkGray = TfpgColor($808080); - clFuchsia = TfpgColor($FF00FF); - clGray = TfpgColor($808080); - clGreen = TfpgColor($008000); - clLime = TfpgColor($00FF00); - clLtGray = TfpgColor($C0C0C0); - clMaroon = TfpgColor($800000); - clNavy = TfpgColor($000080); - clOlive = TfpgColor($808000); - clPurple = TfpgColor($800080); - clRed = TfpgColor($FF0000); - clSilver = TfpgColor($C0C0C0); - clTeal = TfpgColor($008080); - clWhite = TfpgColor($FFFFFF); - clYellow = TfpgColor($FFFF00); - clNone = TfpgColor($1FFFFFFF); - clDefault = TfpgColor($20000000); - - clMoneyGreen = TfpgColor($C0DCC0); - clSkyBlue = TfpgColor($A6CAF0); - clMedGray = TfpgColor($A0A0A4); - - - - - // System named color identifiers. DON'T CHANGE THE ORDER! - - clWindowBackground = $80000001; - clBoxColor = $80000002; - clButtonFace = $80000003; - clShadow1 = $80000004; // nice for disabled text - clShadow2 = $80000005; - clHilite1 = $80000006; - clHilite2 = $80000007; - clText1 = $80000008; // normal text - clText2 = $80000009; // deep dark blue - clText3 = $8000000A; // red/brown - clText4 = $8000000B; // mud dark green - clSelection = $8000000C; - clSelectionText = $8000000D; - clInactiveSel = $8000000E; - clInactiveSelText = $8000000F; - clScrollBar = $80000010; - clListBox = $80000011; - clGridLines = $80000012; - clGridHeader = $80000013; - clWidgetFrame = $80000014; - clInactiveWgFrame = $80000015; - clTextCursor = $80000016; - clChoiceListBox = $80000017; - clUnset = $80000018; - clMenuText = $80000019; - clMenuDisabled = $8000001A; - - - - // De-facto NS & MSIE recognized HTML (web) color names - // NOTE: - // The format is always RRGGBB (Red, Green, Blue); - - clAliceBlue = TfpgColor($f0f8ff); - clAntiqueWhite = TfpgColor($faebd7); - //clAqua = TfpgColor($00ffff); - clAquamarine = TfpgColor($7fffd4); - clAzure = TfpgColor($f0ffff); - clBeige = TfpgColor($f5f5dc); - clBisque = TfpgColor($ffe4c4); - //clBlack = TfpgColor($000000); - clBlanchedAlmond = TfpgColor($ffebcd); - //clBlue = TfpgColor($0000ff); - clBlueViolet = TfpgColor($8a2be2); - clBrown = TfpgColor($a52a2a); - clBurlyWood = TfpgColor($deb887); - clCadetBlue = TfpgColor($5f9ea0); - clChartreuse = TfpgColor($7fff00); - clChocolate = TfpgColor($d2691e); - clCoral = TfpgColor($ff7f50); - clCornflowerBlue = TfpgColor($6495ed); - clCornsilk = TfpgColor($fff8dc); - clCrimson = TfpgColor($dc143c); - clCyan = TfpgColor($00ffff); - clDarkBlue = TfpgColor($00008b); - clDarkCyan = TfpgColor($008b8b); - clDarkGoldenrod = TfpgColor($b8860b); - clDarkGray = TfpgColor($a9a9a9); - clDarkGreen = TfpgColor($006400); - clDarkKhaki = TfpgColor($bdb76b); - clDarkMagenta = TfpgColor($8b008b); - clDarkOliveGreen = TfpgColor($556b2f); - clDarkOrange = TfpgColor($ff8c00); - clDarkOrchid = TfpgColor($9932cc); - clDarkRed = TfpgColor($8b0000); - clDarkSalmon = TfpgColor($e9967a); - clDarkSeaGreen = TfpgColor($8fbc8f); - clDarkSlateBlue = TfpgColor($483d8b); - clDarkSlateGray = TfpgColor($2f4f4f); - clDarkTurquoise = TfpgColor($00ced1); - clDarkViolet = TfpgColor($9400d3); - clDeepPink = TfpgColor($ff1493); - clDeepSkyBlue = TfpgColor($00bfff); - clDimGray = TfpgColor($696969); - clDodgerBlue = TfpgColor($1e90ff); - clFireBrick = TfpgColor($b22222); - clFloralWhite = TfpgColor($fffaf0); - clForestGreen = TfpgColor($228b22); - //clFuchsia = TfpgColor($ff00ff); - clGainsboro = TfpgColor($dcdcdc); - clGhostWhite = TfpgColor($f8f8ff); - clGold = TfpgColor($ffd700); - clGoldenrod = TfpgColor($daa520); - //clGray = TfpgColor($808080); - //clGreen = TfpgColor($008000); - clGreenYellow = TfpgColor($adff2f); - clHoneydew = TfpgColor($f0fff0); - clHotPink = TfpgColor($ff69b4); - clIndianRed = TfpgColor($cd5c5c); - clIndigo = TfpgColor($4b0082); - clIvory = TfpgColor($fffff0); - clKhaki = TfpgColor($f0e68c); - clLavender = TfpgColor($e6e6fa); - clLavenderBlush = TfpgColor($fff0f5); - clLawnGreen = TfpgColor($7cfc00); - clLemonChiffon = TfpgColor($fffacd); - clLightBlue = TfpgColor($add8e6); - clLightCoral = TfpgColor($f08080); - clLightCyan = TfpgColor($e0ffff); - clLightGoldenrodYellow = TfpgColor($fafad2); - clLightGreen = TfpgColor($90ee90); - clLightGrey = TfpgColor($d3d3d3); - clLightPink = TfpgColor($ffb6c1); - clLightSalmon = TfpgColor($ffa07a); - clLightSeaGreen = TfpgColor($20b2aa); - clLightSkyBlue = TfpgColor($87cefa); - clLightSlateGray = TfpgColor($778899); - clLightSteelBlue = TfpgColor($b0c4de); - clLightYellow = TfpgColor($ffffe0); - //clLime = TfpgColor($00ff00); - clLimeGreen = TfpgColor($32cd32); - clLinen = TfpgColor($faf0e6); - clMagenta = TfpgColor($ff00ff); - //clMaroon = TfpgColor($800000); - clMediumAquamarine = TfpgColor($66cdaa); - clMediumBlue = TfpgColor($0000cd); - clMediumOrchid = TfpgColor($ba55d3); - clMediumPurple = TfpgColor($9370db); - clMediumSeaGreen = TfpgColor($3cb371); - clMediumSlateBlue = TfpgColor($7b68ee); - clMediumSpringGreen = TfpgColor($00fa9a); - clMediumTurquoise = TfpgColor($48d1cc); - clMediumVioletRed = TfpgColor($c71585); - clMidnightBlue = TfpgColor($191970); - clMintCream = TfpgColor($f5fffa); - clMistyRose = TfpgColor($ffe4e1); - clMoccasin = TfpgColor($ffe4b5); - clNavajoWhite = TfpgColor($ffdead); - //clNavy = TfpgColor($000080); - clOldLace = TfpgColor($fdf5e6); - //clOlive = TfpgColor($808000); - clOliveDrab = TfpgColor($6b8e23); - clOrange = TfpgColor($ffa500); - clOrangeRed = TfpgColor($ff4500); - clOrchid = TfpgColor($da70d6); - clPaleGoldenrod = TfpgColor($eee8aa); - clPaleGreen = TfpgColor($98fb98); - clPaleTurquoise = TfpgColor($afeeee); - clPaleVioletRed = TfpgColor($db7093); - clPapayaWhip = TfpgColor($ffefd5); - clPeachPuff = TfpgColor($ffdab9); - clPeru = TfpgColor($cd853f); - clPink = TfpgColor($ffc0cb); - clPlum = TfpgColor($dda0dd); - clPowderBlue = TfpgColor($b0e0e6); - //clPurple = TfpgColor($800080); - //clRed = TfpgColor($ff0000); - clRosyBrown = TfpgColor($bc8f8f); - clRoyalBlue = TfpgColor($4169e1); - clSaddleBrown = TfpgColor($8b4513); - clSalmon = TfpgColor($fa8072); - clSandyBrown = TfpgColor($f4a460); - clSeaGreen = TfpgColor($2e8b57); - clSeashell = TfpgColor($fff5ee); - clSienna = TfpgColor($a0522d); - //clSilver = TfpgColor($c0c0c0); - clSkyBlue2 = TfpgColor($87ceeb); - clSlateBlue = TfpgColor($6a5acd); - clSlateGray = TfpgColor($708090); - clSnow = TfpgColor($fffafa); - clSpringGreen = TfpgColor($00ff7f); - clSteelBlue = TfpgColor($4682b4); - clTan = TfpgColor($d2b48c); - //clTeal = TfpgColor($008080); - clThistle = TfpgColor($d8bfd8); - clTomato = TfpgColor($ff6347); - clTurquoise = TfpgColor($40e0d0); - clViolet = TfpgColor($ee82ee); - clWheat = TfpgColor($f5deb3); - //clWhite = TfpgColor($ffffff); - clWhiteSmoke = TfpgColor($f5f5f5); - //clYellow = TfpgColor($ffff00); - clYellowGreen = TfpgColor($9acd32); - diff --git a/prototypes/fpgui2/source/core/resample.pas b/prototypes/fpgui2/source/core/resample.pas deleted file mode 100644 index 82fb5ac1..00000000 --- a/prototypes/fpgui2/source/core/resample.pas +++ /dev/null @@ -1,657 +0,0 @@ -unit resample; - -{$Mode delphi}{$H+} - -// ----------------------------------------------------------------------------- -// Project: bitmap resampler -// Module: resample -// Description: Interpolated Bitmap Resampling using filters. -// Version: 01.02 -// Release: 3 -// Date: 15-MAR-1998 -// Target: Win32, Delphi 2 & 3 -// Author(s): anme: Anders Melander, anders@melander.dk -// Copyright (c) 1997,98 by Anders Melander -// Formatting: 2 space indent, 8 space tabs, 80 columns. -// ----------------------------------------------------------------------------- -// This software is copyrighted as noted above. It may be freely copied, -// modified, and redistributed, provided that the copyright notice(s) is -// preserved on all copies. -// -// There is no warranty or other guarantee of fitness for this software, -// it is provided solely "as is". Bug reports or fixes may be sent -// to the author, who may or may not act on them as he desires. -// -// You may not include this software in a program or other software product -// without supplying the source, or without informing the end-user that the -// source is available for no extra charge. -// -// If you modify this software, you should include a notice in the "Revision -// history" section giving the name of the person performing the modification, -// the date of modification, and the reason for such modification. -// ----------------------------------------------------------------------------- -// Here's some additional copyrights for you: -// -// From filter.c: -// The authors and the publisher hold no copyright restrictions -// on any of these files; this source code is public domain, and -// is freely available to the entire computer graphics community -// for study, use, and modification. We do request that the -// comment at the top of each file, identifying the original -// author and its original publication in the book Graphics -// Gems, be retained in all programs that use these files. -// -// ----------------------------------------------------------------------------- -// Revision history: -// -// 0100 110997 anme - Adapted from fzoom v0.20 by Dale Schumacher. -// -// 0101 110198 anme - Added Lanczos3 and Mitchell filters. -// - Fixed range bug. -// Min value was not checked on conversion from Single to -// byte. -// - Numerous optimizations. -// - Added TImage stretch on form resize. -// - Added support for Delphi 2 via TCanvas.Pixels. -// - Renamed module from stretch to resample. -// - Moved demo code to separate module. -// -// 0102 150398 anme - Fixed a problem that caused all pixels to be shifted -// 1/2 pixel down and to the right (in source -// coordinates). Thanks to David Ullrich for the -// solution. -// ----------------------------------------------------------------------------- -// Credits: -// The algorithms and methods used in this library are based on the article -// "General Filtered Image Rescaling" by Dale Schumacher which appeared in the -// book Graphics Gems III, published by Academic Press, Inc. -// -// The edge offset problem was fixed by: -// * David Ullrich <ullrich@hardy.math.okstate.edu> -// ----------------------------------------------------------------------------- -// To do (in rough order of priority): -// * Implement Dale Schumacher's "Optimized Bitmap Scaling Routines". -// * Fix BoxFilter. -// * Optimize to use integer math instead of floating point where possible. -// ----------------------------------------------------------------------------- -interface - -// If USE_SCANLINE is defined, Stretch will use the TBitmap.Scanline property -// instead of TBitmap.Canvas.Pixels to access the bitmap pixels. -// Use of the Scanline property is 20 to 50 times faster than the Pixels -// property! -{$IFDEF VER100} -{.$DEFINE USE_SCANLINE} -{$ENDIF} - - -uses - SysUtils, Classes, gfxbase, fpgfx; - -type - // Type of a filter for use with Stretch() - TFilterProc = function(Value: Single): Single; - - // Sample filters for use with Stretch() - function SplineFilter(Value: Single): Single; - function BellFilter(Value: Single): Single; - function TriangleFilter(Value: Single): Single; - function BoxFilter(Value: Single): Single; - function HermiteFilter(Value: Single): Single; - function Lanczos3Filter(Value: Single): Single; - function MitchellFilter(Value: Single): Single; - - // Interpolator - // Src: Source bitmap - // Dst: Destination bitmap - // filter: Weight calculation filter - // fwidth: Relative sample radius - procedure Stretch(Src, Dst: TfpgImage; filter: TFilterProc; fwidth: single); - -// ----------------------------------------------------------------------------- -// -// List of Filters -// -// ----------------------------------------------------------------------------- - -const - ResampleFilters: array[0..6] of record - Name: string; // Filter name - Filter: TFilterProc;// Filter implementation - Width: Single; // Suggested sampling width/radius - end = ( - (Name: 'Box'; Filter: BoxFilter; Width: 0.5), - (Name: 'Triangle'; Filter: TriangleFilter; Width: 1.0), - (Name: 'Hermite'; Filter: HermiteFilter; Width: 1.0), - (Name: 'Bell'; Filter: BellFilter; Width: 1.5), - (Name: 'B-Spline'; Filter: SplineFilter; Width: 2.0), - (Name: 'Lanczos3'; Filter: Lanczos3Filter; Width: 3.0), - (Name: 'Mitchell'; Filter: MitchellFilter; Width: 2.0) - ); - -implementation - -uses - math; - -// ----------------------------------------------------------------------------- -// -// Filter functions -// -// ----------------------------------------------------------------------------- - -// Hermite filter -function HermiteFilter(Value: Single): Single; -begin - // f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1 - if (Value < 0.0) then - Value := -Value; - if (Value < 1.0) then - Result := (2.0 * Value - 3.0) * Sqr(Value) + 1.0 - else - Result := 0.0; -end; - -// Box filter -// a.k.a. "Nearest Neighbour" filter -// anme: I have not been able to get acceptable -// results with this filter for subsampling. -function BoxFilter(Value: Single): Single; -begin - if (Value > -0.5) and (Value <= 0.5) then - Result := 1.0 - else - Result := 0.0; -end; - -// Triangle filter -// a.k.a. "Linear" or "Bilinear" filter -function TriangleFilter(Value: Single): Single; -begin - if (Value < 0.0) then - Value := -Value; - if (Value < 1.0) then - Result := 1.0 - Value - else - Result := 0.0; -end; - -// Bell filter -function BellFilter(Value: Single): Single; -begin - if (Value < 0.0) then - Value := -Value; - if (Value < 0.5) then - Result := 0.75 - Sqr(Value) - else if (Value < 1.5) then - begin - Value := Value - 1.5; - Result := 0.5 * Sqr(Value); - end else - Result := 0.0; -end; - -// B-spline filter -function SplineFilter(Value: Single): Single; -var - tt : single; -begin - if (Value < 0.0) then - Value := -Value; - if (Value < 1.0) then - begin - tt := Sqr(Value); - Result := 0.5*tt*Value - tt + 2.0 / 3.0; - end else if (Value < 2.0) then - begin - Value := 2.0 - Value; - Result := 1.0/6.0 * Sqr(Value) * Value; - end else - Result := 0.0; -end; - -// Lanczos3 filter -function Lanczos3Filter(Value: Single): Single; - function SinC(Value: Single): Single; - begin - if (Value <> 0.0) then - begin - Value := Value * Pi; - Result := sin(Value) / Value - end else - Result := 1.0; - end; -begin - if (Value < 0.0) then - Value := -Value; - if (Value < 3.0) then - Result := SinC(Value) * SinC(Value / 3.0) - else - Result := 0.0; -end; - -function MitchellFilter(Value: Single): Single; -const - B = (1.0 / 3.0); - C = (1.0 / 3.0); -var - tt : single; -begin - if (Value < 0.0) then - Value := -Value; - tt := Sqr(Value); - if (Value < 1.0) then - begin - Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * tt)) - + ((-18.0 + 12.0 * B + 6.0 * C) * tt) - + (6.0 - 2 * B)); - Result := Value / 6.0; - end else - if (Value < 2.0) then - begin - Value := (((-1.0 * B - 6.0 * C) * (Value * tt)) - + ((6.0 * B + 30.0 * C) * tt) - + ((-12.0 * B - 48.0 * C) * Value) - + (8.0 * B + 24 * C)); - Result := Value / 6.0; - end else - Result := 0.0; -end; - -// ----------------------------------------------------------------------------- -// -// Interpolator -// -// ----------------------------------------------------------------------------- -type - // Contributor for a pixel - TContributor = record - pixel: integer; // Source pixel - weight: single; // Pixel weight - end; - - TContributorList = array[0..0] of TContributor; - PContributorList = ^TContributorList; - - // List of source pixels contributing to a destination pixel - TCList = record - n : integer; - p : PContributorList; - end; - - TCListList = array[0..0] of TCList; - PCListList = ^TCListList; - - TRGB = packed record - r, g, b : single; - end; - - // Physical bitmap pixel - TColorRGB = packed record - r, g, b : BYTE; - end; - PColorRGB = ^TColorRGB; - - // Physical bitmap scanline (row) - TRGBList = packed array[0..0] of TColorRGB; - PRGBList = ^TRGBList; - -procedure Stretch(Src, Dst: TfpgImage; filter: TFilterProc; fwidth: single); -var - xscale, yscale : single; // Zoom scale factors - i, j, k : integer; // Loop variables - center : single; // Filter calculation variables - width, fscale, weight : single; // Filter calculation variables - left, right : integer; // Filter calculation variables - n : integer; // Pixel number - Work : TfpgImage; - contrib : PCListList; - rgb : TRGB; - color : TColorRGB; -{$IFDEF USE_SCANLINE} - SourceLine , - DestLine : PRGBList; - SourcePixel , - DestPixel : PColorRGB; - Delta , - DestDelta : integer; -{$ENDIF} - SrcWidth , - SrcHeight , - DstWidth , - DstHeight : integer; - - function Color2RGB(Color: TfpgColor): TColorRGB; - begin - Result.r := (Color AND $00FF0000) SHR 16; - Result.g := (Color AND $0000FF00) SHR 8; - Result.b := Color AND $000000FF; - -// Result.r := Color AND $000000FF; -// Result.g := (Color AND $0000FF00) SHR 8; -// Result.b := (Color AND $00FF0000) SHR 16; - end; - - function RGB2Color(Color: TColorRGB): TfpgColor; - begin - Result := Color.b OR (Color.g SHL 8) OR (Color.r SHL 16); -// Result := Color.r OR (Color.g SHL 8) OR (Color.b SHL 16); - end; - -begin - DstWidth := Dst.Width; - DstHeight := Dst.Height; - SrcWidth := Src.Width; - SrcHeight := Src.Height; - if (SrcWidth < 1) or (SrcHeight < 1) then - raise Exception.Create('Source bitmap too small'); - - // Create intermediate image to hold horizontal zoom - Work := TfpgImage.Create; - try -// Work.Height := SrcHeight; -// Work.Width := DstWidth; - Work.AllocateImage(src.ColorDepth, DstWidth, SrcHeight); - // xscale := DstWidth / SrcWidth; - // yscale := DstHeight / SrcHeight; - // Improvement suggested by David Ullrich: - if (SrcWidth = 1) then - xscale:= DstWidth / SrcWidth - else - xscale:= (DstWidth - 1) / (SrcWidth - 1); - if (SrcHeight = 1) then - yscale:= DstHeight / SrcHeight - else - yscale:= (DstHeight - 1) / (SrcHeight - 1); - // This implementation only works on 24-bit images because it uses - // TBitmap.Scanline -{$IFDEF USE_SCANLINE} - Src.PixelFormat := pf24bit; - Dst.PixelFormat := Src.PixelFormat; - Work.PixelFormat := Src.PixelFormat; -{$ENDIF} - - // -------------------------------------------- - // Pre-calculate filter contributions for a row - // ----------------------------------------------- - GetMem(contrib, DstWidth* sizeof(TCList)); - // Horizontal sub-sampling - // Scales from bigger to smaller width - if (xscale < 1.0) then - begin - width := fwidth / xscale; - fscale := 1.0 / xscale; - for i := 0 to DstWidth-1 do - begin - contrib^[i].n := 0; - GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor)); - center := i / xscale; - // Original code: - // left := ceil(center - width); - // right := floor(center + width); - left := floor(center - width); - right := ceil(center + width); - for j := left to right do - begin - weight := filter((center - j) / fscale) / fscale; - if (weight = 0.0) then - continue; - if (j < 0) then - n := -j - else if (j >= SrcWidth) then - n := SrcWidth - j + SrcWidth - 1 - else - n := j; - k := contrib^[i].n; - contrib^[i].n := contrib^[i].n + 1; - contrib^[i].p^[k].pixel := n; - contrib^[i].p^[k].weight := weight; - end; - end; - end else - // Horizontal super-sampling - // Scales from smaller to bigger width - begin - for i := 0 to DstWidth-1 do - begin - contrib^[i].n := 0; - GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor)); - center := i / xscale; - // Original code: - // left := ceil(center - fwidth); - // right := floor(center + fwidth); - left := floor(center - fwidth); - right := ceil(center + fwidth); - for j := left to right do - begin - weight := filter(center - j); - if (weight = 0.0) then - continue; - if (j < 0) then - n := -j - else if (j >= SrcWidth) then - n := SrcWidth - j + SrcWidth - 1 - else - n := j; - k := contrib^[i].n; - contrib^[i].n := contrib^[i].n + 1; - contrib^[i].p^[k].pixel := n; - contrib^[i].p^[k].weight := weight; - end; - end; - end; - - // ---------------------------------------------------- - // Apply filter to sample horizontally from Src to Work - // ---------------------------------------------------- - for k := 0 to SrcHeight-1 do - begin -{$IFDEF USE_SCANLINE} - SourceLine := Src.ScanLine[k]; - DestPixel := Work.ScanLine[k]; -{$ENDIF} - for i := 0 to DstWidth-1 do - begin - rgb.r := 0.0; - rgb.g := 0.0; - rgb.b := 0.0; - for j := 0 to contrib^[i].n-1 do - begin -{$IFDEF USE_SCANLINE} - color := SourceLine^[contrib^[i].p^[j].pixel]; -{$ELSE} - color := Color2RGB(Src.Colors[contrib^[i].p^[j].pixel, k]); -// color := Color2RGB(Src.Canvas.Pixels[contrib^[i].p^[j].pixel, k]); -{$ENDIF} - weight := contrib^[i].p^[j].weight; - if (weight = 0.0) then - continue; - rgb.r := rgb.r + color.r * weight; - rgb.g := rgb.g + color.g * weight; - rgb.b := rgb.b + color.b * weight; - end; - if (rgb.r > 255.0) then - color.r := 255 - else if (rgb.r < 0.0) then - color.r := 0 - else - color.r := round(rgb.r); - if (rgb.g > 255.0) then - color.g := 255 - else if (rgb.g < 0.0) then - color.g := 0 - else - color.g := round(rgb.g); - if (rgb.b > 255.0) then - color.b := 255 - else if (rgb.b < 0.0) then - color.b := 0 - else - color.b := round(rgb.b); -{$IFDEF USE_SCANLINE} - // Set new pixel value - DestPixel^ := color; - // Move on to next column - inc(DestPixel); -{$ELSE} - Work.Colors[i, k] := RGB2Color(color); -// Work.Canvas.Pixels[i, k] := RGB2Color(color); -{$ENDIF} - end; - end; - - // Free the memory allocated for horizontal filter weights - for i := 0 to DstWidth-1 do - FreeMem(contrib^[i].p); - - FreeMem(contrib); - - // ----------------------------------------------- - // Pre-calculate filter contributions for a column - // ----------------------------------------------- - GetMem(contrib, DstHeight* sizeof(TCList)); - // Vertical sub-sampling - // Scales from bigger to smaller height - if (yscale < 1.0) then - begin - width := fwidth / yscale; - fscale := 1.0 / yscale; - for i := 0 to DstHeight-1 do - begin - contrib^[i].n := 0; - GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor)); - center := i / yscale; - // Original code: - // left := ceil(center - width); - // right := floor(center + width); - left := floor(center - width); - right := ceil(center + width); - for j := left to right do - begin - weight := filter((center - j) / fscale) / fscale; - if (weight = 0.0) then - continue; - if (j < 0) then - n := -j - else if (j >= SrcHeight) then - n := SrcHeight - j + SrcHeight - 1 - else - n := j; - k := contrib^[i].n; - contrib^[i].n := contrib^[i].n + 1; - contrib^[i].p^[k].pixel := n; - contrib^[i].p^[k].weight := weight; - end; - end - end else - // Vertical super-sampling - // Scales from smaller to bigger height - begin - for i := 0 to DstHeight-1 do - begin - contrib^[i].n := 0; - GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor)); - center := i / yscale; - // Original code: - // left := ceil(center - fwidth); - // right := floor(center + fwidth); - left := floor(center - fwidth); - right := ceil(center + fwidth); - for j := left to right do - begin - weight := filter(center - j); - if (weight = 0.0) then - continue; - if (j < 0) then - n := -j - else if (j >= SrcHeight) then - n := SrcHeight - j + SrcHeight - 1 - else - n := j; - k := contrib^[i].n; - contrib^[i].n := contrib^[i].n + 1; - contrib^[i].p^[k].pixel := n; - contrib^[i].p^[k].weight := weight; - end; - end; - end; - - // -------------------------------------------------- - // Apply filter to sample vertically from Work to Dst - // -------------------------------------------------- -{$IFDEF USE_SCANLINE} - SourceLine := Work.ScanLine[0]; - Delta := integer(Work.ScanLine[1]) - integer(SourceLine); - DestLine := Dst.ScanLine[0]; - DestDelta := integer(Dst.ScanLine[1]) - integer(DestLine); -{$ENDIF} - for k := 0 to DstWidth-1 do - begin -{$IFDEF USE_SCANLINE} - DestPixel := pointer(DestLine); -{$ENDIF} - for i := 0 to DstHeight-1 do - begin - rgb.r := 0; - rgb.g := 0; - rgb.b := 0; - // weight := 0.0; - for j := 0 to contrib^[i].n-1 do - begin -{$IFDEF USE_SCANLINE} - color := PColorRGB(integer(SourceLine)+contrib^[i].p^[j].pixel*Delta)^; -{$ELSE} - color := Color2RGB(Work.Colors[k, contrib^[i].p^[j].pixel]); -// color := Color2RGB(Work.Canvas.Pixels[k, contrib^[i].p^[j].pixel]); -{$ENDIF} - weight := contrib^[i].p^[j].weight; - if (weight = 0.0) then - continue; - rgb.r := rgb.r + color.r * weight; - rgb.g := rgb.g + color.g * weight; - rgb.b := rgb.b + color.b * weight; - end; - if (rgb.r > 255.0) then - color.r := 255 - else if (rgb.r < 0.0) then - color.r := 0 - else - color.r := round(rgb.r); - if (rgb.g > 255.0) then - color.g := 255 - else if (rgb.g < 0.0) then - color.g := 0 - else - color.g := round(rgb.g); - if (rgb.b > 255.0) then - color.b := 255 - else if (rgb.b < 0.0) then - color.b := 0 - else - color.b := round(rgb.b); -{$IFDEF USE_SCANLINE} - DestPixel^ := color; - inc(integer(DestPixel), DestDelta); -{$ELSE} - Dst.Colors[k, i] := RGB2Color(color); -// Dst.Canvas.Pixels[k, i] := RGB2Color(color); -{$ENDIF} - end; -{$IFDEF USE_SCANLINE} - Inc(SourceLine, 1); - Inc(DestLine, 1); -{$ENDIF} - end; - - // Free the memory allocated for vertical filter weights - for i := 0 to DstHeight-1 do - FreeMem(contrib^[i].p); - - FreeMem(contrib); - - finally - Work.Free; - end; -end; - -end. diff --git a/prototypes/fpgui2/source/core/stdimages.inc b/prototypes/fpgui2/source/core/stdimages.inc deleted file mode 100644 index b195625c..00000000 --- a/prototypes/fpgui2/source/core/stdimages.inc +++ /dev/null @@ -1,2282 +0,0 @@ - -Const - stdimg_list_add_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0,215, 13, 0, 0,215, 13, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,182,132, - 93,164,101, 52,164,101, 52,182,132, 93,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,164,101, 52,230,206, - 183,230,206,183,164,101, 52,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,164,101, 52,230,206,183,217,173, - 134,164,101, 52,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,164,101, 52,230,206,183,217,173,134,164,101, - 52,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,182,132, 93,164,101, 52,164,101, 52, - 164,101, 52,164,101, 52,217,173,134,217,173,134,164,101, 52,164,101, - 52,164,101, 52,164,101, 52,182,132, 93,255,255,255,255,255,255,255, - 255,255,255,255,255,164,101, 52,229,204,180,219,183,149,219,182,148, - 218,180,146,218,179,144,217,173,134,216,170,131,215,168,127,215,166, - 125,224,190,159,164,101, 52,255,255,255,255,255,255,255,255,255,255, - 255,255,164,101, 52,232,211,192,231,209,187,231,209,188,230,206,183, - 230,206,183,230,206,183,230,206,183,230,205,182,230,204,181,230,204, - 182,164,101, 52,255,255,255,255,255,255,255,255,255,255,255,255,182, - 132, 93,164,101, 52,164,101, 52,164,101, 52,164,101, 52,230,206,183, - 230,206,183,164,101, 52,164,101, 52,164,101, 52,164,101, 52,182,132, - 93,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,164,101, 52,230,206,183,230,206,183, - 164,101, 52,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,164,101, 52,230,206,183,230,206,183,164,101, 52, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,164,101, 52,230,206,183,230,206,183,164,101, 52,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,182, - 132, 93,164,101, 52,164,101, 52,182,132, 93,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_menu_saveas_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,216,171,142,205,149,112,189,115, 66,183,104, 53,181,104, - 53,180,103, 52,178,102, 52,176,101, 51,174,100, 51,172, 99, 50,170, - 98, 50,169, 97, 50,168, 96, 49,167, 97, 50,171,105, 60,188,134, 97, - 195,125, 79,235,198,173,234,197,173,254,251,248,254,251,248,254,251, - 248,254,251,248,254,251,248,254,251,248,254,251,248,254,251,248,254, - 251,248,254,251,248,200,154,124,199,152,121,173,107, 64,186,108, 56, - 237,202,179,224,162,122,254,250,247, 98,192,136, 98,192,136, 98,192, - 136, 98,192,136, 98,192,136, 98,192,136, 98,192,136, 98,192,136,253, - 249,246,202,141,101,201,155,124,167, 97, 50,187,108, 56,238,204,182, - 225,162,122,254,250,247,191,220,194,191,220,194,191,220,194,191,220, - 194,191,220,194,191,220,194,191,220,194,191,220,194,253,249,246,205, - 144,104,204,158,129,168, 97, 50,187,107, 56,239,206,184,225,162,121, - 254,250,247, 98,192,136, 98,192,136,206,247,255, 41, 41, 41, 82, 82, - 82,206,247,255, 98,192,136, 98,192,136,253,249,246,207,147,106,206, - 163,132,170, 97, 50,186,106, 54,239,208,187,226,162,122,254,251,248, - 206,247,255,206,247,255,206,247,255,206,247,255,206,247,255,206,247, - 255,206,247,255,206,247,255,254,251,248,211,150,109,210,167,138,171, - 98, 50,187,106, 54,240,210,190,226,163,122,226,163,122,206,247,255, - 206,247,255,206,247,255, 41, 41, 41, 82, 82, 82,206,247,255,206,247, - 255,206,247,255,216,153,113,214,153,112,213,171,142,173, 99, 51,187, - 106, 54,242,213,194,227,163,122,208,242,250,206,247,255,206,247,255, - 206,247,255, 82, 82, 82, 41, 41, 41,132,156,165,206,247,255,206,247, - 255,210,247,254,217,155,115,218,176,149,175,100, 51,187,106, 54,242, - 216,197,227,164,123,181,238,254,181,239,255,181,239,255,181,239,255, - 181,239,255, 82, 82, 82, 41, 41, 41, 82, 82, 82,181,239,255,181,239, - 254,220,157,116,221,181,154,177,101, 52,187,107, 54,244,217,199,230, - 166,125,186,236,250,181,239,255, 41, 41, 41, 82, 82, 82,181,239,255, - 181,239,255, 41, 41, 41, 41, 41, 41,181,239,255,186,239,253,218,156, - 116,225,186,159,179,102, 52,187,108, 55,244,220,201,231,167,125,201, - 230,240,181,239,255, 41, 41, 41, 41, 41, 41,181,239,255,132,156,165, - 41, 41, 41, 41, 41, 41,181,239,255,201,239,249,222,160,119,228,190, - 164,180,103, 52,189,110, 58,245,221,204,231,168,126,250,240,232,181, - 239,255,132,156,165, 41, 41, 41, 41, 41, 41, 41, 41, 41, 41, 41, 41, - 132,156,165,181,239,255,247,229,217,224,162,120,231,194,169,182,104, - 53,192,116, 66,246,223,208,232,168,126,252,246,241,198,242,246,148, - 247,255,148,247,255,148,247,255,148,247,255,148,247,255,148,247,255, - 184,228,232,247,230,219,225,163,122,239,213,195,183,106, 54,198,130, - 85,246,223,209,233,170,128,254,250,246,253,250,246,218,241,243,175, - 244,250,153,246,254,153,246,254,175,244,250,218,241,243,249,236,226, - 248,231,219,238,208,186,236,208,189,189,116, 67,214,165,133,246,224, - 209,247,224,209,254,251,248,254,251,247,253,249,246,252,245,240,250, - 240,234,251,242,237,253,249,246,253,250,247,251,241,235,248,233,223, - 236,209,190,205,146,106,226,197,177,225,189,166,217,171,141,201,137, - 94,192,117, 67,189,110, 58,187,108, 55,187,107, 54,187,106, 54,187, - 106, 54,188,108, 57,189,110, 59,187,109, 58,191,116, 68,201,141,101, - 231,206,188,255,255,255); - -Const - stdimg_help_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,236,227, - 220,192,161,139,164,117, 85,142, 85, 45,142, 85, 45,165,119, 87,193, - 161,139,236,227,220,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,254,254,253,198,169,149,147, 91, 53,203,175, - 155,229,214,203,248,244,241,249,245,242,232,219,209,211,186,167,149, - 94, 56,199,171,151,254,254,253,255,255,255,255,255,255,255,255,255, - 254,254,253,163,116, 84,175,134,105,243,237,233,221,201,186,199,165, - 139,187,145,113,193,153,121,213,183,159,233,218,205,248,243,239,183, - 145,117,166,120, 88,254,254,253,255,255,255,255,255,255,199,170,150, - 174,133,105,243,238,233,183,143,114,165,114, 76,179,135,101,255,255, - 255,255,255,255,193,151,116,197,155,120,215,185,160,249,245,241,180, - 140,112,199,171,151,255,255,255,236,227,220,146, 91, 52,242,235,230, - 177,135,105,157,103, 64,163,111, 73,178,132, 98,255,255,255,255,255, - 255,189,146,111,193,150,114,197,155,120,214,183,157,247,241,237,147, - 93, 54,236,227,220,192,161,139,195,166,145,211,188,173,148, 92, 51, - 154,100, 60,161,108, 69,169,120, 82,200,168,143,204,173,148,183,137, - 101,187,143,107,191,147,112,193,150,115,231,215,201,207,181,161,193, - 161,139,162,115, 83,221,204,192,175,134,106,145, 88, 47,151, 96, 56, - 157,103, 64,167,118, 81,228,212,200,229,214,202,180,134, 98,182,135, - 99,185,139,103,186,142,106,209,178,155,230,215,204,165,118, 86,141, - 83, 43,245,240,237,148, 94, 56,142, 83, 42,148, 91, 51,153, 98, 58, - 159,105, 66,243,237,232,255,255,255,208,181,160,176,127, 90,178,131, - 94,180,133, 96,189,148,117,248,243,240,142, 84, 45,141, 83, 43,245, - 240,237,147, 92, 54,138, 79, 37,144, 86, 45,149, 93, 52,154, 99, 59, - 181,139,109,252,251,249,254,254,254,193,157,130,172,122, 84,173,124, - 86,183,141,108,247,243,239,142, 84, 44,162,115, 83,221,204,192,172, - 130,101,135, 74, 32,139, 80, 39,144, 86, 45,149, 92, 52,153, 98, 58, - 194,161,137,255,255,255,243,236,232,165,114, 75,166,115, 77,195,161, - 134,225,210,198,164,117, 85,192,161,139,195,165,144,208,185,169,135, - 74, 32,135, 74, 32,159,110, 75,160,111, 77,148, 91, 50,168,122, 89, - 255,255,255,253,252,251,161,109, 70,159,106, 67,218,198,183,198,170, - 149,192,161,139,236,227,220,146, 92, 53,241,234,229,165,120, 88,135, - 74, 32,176,136,108,254,253,253,233,222,214,246,242,239,255,255,255, - 220,202,189,152, 96, 56,179,137,107,242,235,230,145, 91, 52,236,227, - 220,255,255,255,198,169,149,173,131,103,242,235,231,166,120, 89,156, - 105, 71,222,206,194,247,243,240,241,234,230,208,184,167,160,111, 77, - 173,130,100,243,237,232,171,128, 98,198,169,149,255,255,255,255,255, - 255,254,254,253,163,116, 84,170,127, 97,240,232,227,208,185,169,172, - 130,101,150, 96, 59,150, 96, 59,172,130,101,209,186,170,240,233,228, - 170,128, 98,163,116, 84,254,254,253,255,255,255,255,255,255,255,255, - 255,254,254,253,198,169,149,145, 91, 52,193,162,141,219,201,189,244, - 239,235,244,239,235,219,201,189,193,163,141,145, 90, 51,199,170,150, - 254,254,253,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,236,227,220,192,161,139,162,115, 83,141, 83, 43,141, - 83, 43,162,115, 83,192,161,139,236,227,220,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_dialog_error_32 : Array[0..3125] of byte = ( - 66, 77, 54, 12, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 32, 0, 0, 0, 32, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 12, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,254,254,254,249,249,249,242,242,242,233, - 233,233,225,225,225,219,219,219,213,213,213,208,208,208,204,204,204, - 208,208,208,211,211,211,216,216,216,222,222,222,229,229,229,239,239, - 239,247,247,247,252,252,252,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,245,245,245,231,231, - 231,219,219,219,208,208,208,198,198,198,187,187,187,178,178,178,169, - 169,169,162,162,162,156,156,156,153,153,153,154,154,154,157,157,157, - 162,162,162,170,170,170,179,179,179,189,189,189,199,199,199,209,209, - 209,222,222,222,239,239,239,252,252,252,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,245,245,245,233,233,233,220,220,220,208,208,208,195,195, - 195,183,183,183,159,159,170,102,102,164, 44, 44,169, 20, 20,172, 8, - 8,175, 2, 2,177, 7, 7,174, 19, 19,171, 40, 40,165, 96, 96,158, - 149,149,160,172,172,172,184,184,184,197,197,197,209,209,209,222,222, - 222,235,235,235,252,252,252,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,254,254,254, - 242,242,242,231,231,231,219,219,219,179,179,204, 60, 60,185, 6, 6, - 179, 16, 18,187, 25, 33,199, 39, 52,207, 49, 65,211, 57, 76,215, 48, - 65,210, 38, 50,203, 24, 32,197, 16, 17,184, 6, 6,178, 59, 59,182, - 171,171,196,209,209,209,221,221,221,232,232,232,244,244,244,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,250,250,253, - 101,101,208, 10, 10,182, 21, 26,196, 61, 78,218, 54, 70,218, 36, 46, - 211, 25, 30,207, 18, 22,205, 15, 17,203, 18, 22,203, 25, 30,205, 35, - 45,208, 52, 69,213, 55, 75,215, 21, 26,194, 9, 9,181,104,104,206, - 245,245,248,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,235,235,249, 51, 51,195, 17, 18,191, 59, 74,219, - 51, 64,218, 19, 21,209, 10, 10,206, 10, 10,205, 10, 10,205, 10, 10, - 204, 10, 10,203, 9, 9,203, 9, 9,202, 9, 9,201, 9, 9,200, 19, - 22,203, 47, 62,212, 53, 71,213, 15, 17,187, 54, 54,196,236,236,249, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,239,239,250, 27, - 27,187, 22, 26,198, 66, 82,225, 26, 31,214, 11, 11,210, 11, 11,209, - 11, 11,208, 11, 11,208, 10, 10,207, 10, 10,206, 10, 10,205, 10, 10, - 205, 10, 10,204, 10, 10,204, 9, 9,203, 9, 9,202, 9, 9,202, 24, - 30,206, 59, 78,217, 20, 24,193, 30, 30,188,240,240,250,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,252,252,254, 57, 57,197, 24, 27,202, 64, 78,226, 20, - 22,215, 12, 12,213, 12, 12,212, 12, 12,211, 11, 11,211, 11, 11,210, - 11, 11,209, 11, 11,209, 11, 11,208, 11, 11,207, 10, 10,207, 10, 10, - 206, 10, 10,205, 10, 10,204, 10, 10,204, 10, 10,203, 17, 20,205, 56, - 74,217, 21, 25,194, 60, 60,197,252,252,254,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,120,120, - 216, 19, 20,194, 68, 82,229, 19, 21,218, 13, 13,216, 13, 13,215, 12, - 12,214, 12, 12,214, 12, 12,213, 12, 12,212, 12, 12,211, 11, 11,211, - 11, 11,210, 11, 11,210, 11, 11,209, 11, 11,208, 11, 11,208, 10, 10, - 207, 10, 10,206, 10, 10,205, 10, 10,205, 17, 19,206, 60, 78,219, 18, - 19,191,124,124,217,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,230,230,247, 17, 17,187, 63, 75,228, 28, 31, - 222, 13, 13,219, 13, 13,218, 13, 13,217, 13, 13,216, 13, 13,216, 13, - 13,215, 12, 12,215, 12, 12,214, 12, 12,213, 12, 12,213, 12, 12,212, - 12, 12,211, 11, 11,210, 11, 11,210, 11, 11,209, 11, 11,208, 11, 11, - 208, 11, 11,207, 10, 10,207, 23, 28,210, 53, 69,217, 17, 17,185,232, - 232,248,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 91, 91,207, 28, 31,208, 53, 61,229, 14, 14,221, 14, 14,221, 14, 14, - 220, 14, 14,220, 14, 14,219, 13, 13,218, 13, 13,218, 13, 13,217, 13, - 13,216, 13, 13,215, 12, 12,215, 12, 12,214, 12, 12,214, 12, 12,213, - 12, 12,212, 12, 12,211, 11, 11,211, 11, 11,210, 11, 11,209, 11, 11, - 209, 11, 11,208, 47, 59,217, 23, 27,200, 94, 94,208,255,255,255,255, - 255,255,255,255,255,255,255,255,240,240,250, 10, 10,183, 70, 82,232, - 29, 30,227, 29, 29,226, 22, 22,224, 14, 14,223, 14, 14,222, 14, 14, - 221, 14, 14,220, 14, 14,220, 14, 14,219, 13, 13,219, 13, 13,218, 13, - 13,217, 13, 13,216, 13, 13,216, 13, 13,215, 12, 12,214, 12, 12,214, - 12, 12,213, 12, 12,213, 12, 12,212, 12, 12,211, 11, 11,210, 18, 21, - 212, 60, 77,222, 9, 10,182,242,242,251,255,255,255,255,255,255,255, - 255,255,166,166,228, 24, 25,197,104,111,238, 84, 84,235, 84, 84,234, - 84, 84,234, 72, 72,232, 51, 51,229, 25, 25,225, 15, 15,223, 14, 14, - 222, 14, 14,221, 14, 14,221, 14, 14,220, 14, 14,219, 13, 13,219, 13, - 13,218, 13, 13,218, 13, 13,217, 13, 13,216, 13, 13,215, 12, 12,215, - 12, 12,214, 12, 12,213, 12, 12,213, 12, 12,212, 58, 72,223, 20, 22, - 193,170,170,229,255,255,255,255,255,255,255,255,255, 78, 78,204, 55, - 58,217,103,107,240, 82, 82,236, 83, 83,236, 83, 83,236, 83, 83,235, - 82, 82,234, 81, 81,234, 58, 58,230, 26, 26,225, 15, 15,224, 15, 15, - 223, 14, 14,223, 14, 14,222, 14, 14,221, 14, 14,220, 14, 14,220, 14, - 14,219, 13, 13,218, 13, 13,218, 13, 13,217, 13, 13,216, 13, 13,216, - 13, 13,215, 12, 12,214, 40, 48,221, 28, 34,205, 82, 82,203,255,255, - 255,255,255,255,255,255,255, 38, 38,193, 88, 94,229, 93, 95,240, 80, - 80,237, 80, 80,237, 80, 80,237,243,243,243,243,243,243,243,243,243, - 243,243,243,243,243,243,241,241,241,239,239,239,239,239,239,239,239, - 239,239,239,239,239,239,239,239,239,239,239,239,239,239,239,239,239, - 239,239,239,239,239,239,239,239, 13, 13,218, 13, 13,217, 23, 23,218, - 51, 56,223, 46, 55,215, 40, 40,192,255,255,255,255,255,255,255,255, - 255, 16, 16,185,109,115,238, 87, 87,240, 79, 79,239, 79, 79,239, 79, - 79,238,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243, - 243,243,243,243,243,243,240,240,240,239,239,239,239,239,239,239,239, - 239,239,239,239,239,239,239,239,239,239,239,239,239,239,239,239,239, - 239,239, 23, 23,221, 57, 57,226, 79, 79,229, 87, 89,229, 76, 87,225, - 19, 19,185,255,255,255,255,255,255,255,255,255, 3, 3,180,120,126, - 244, 81, 82,242, 77, 77,241, 77, 77,240, 77, 77,240,243,243,243,243, - 243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243, - 243,243,243,241,241,241,239,239,239,239,239,239,239,239,239,239,239, - 239,239,239,239,239,239,239,239,239,239,241,241,241, 74, 74,231, 76, - 76,231, 76, 76,230, 82, 84,230, 97,110,233, 5, 5,180,255,255,255, - 255,255,255,255,255,255, 16, 16,185,103,108,239, 84, 85,244, 75, 75, - 243, 75, 75,242, 75, 75,241,243,243,243,243,243,243,243,243,243,243, - 243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243, - 242,242,242,240,240,240,240,240,240,239,239,239,240,240,240,242,242, - 242,243,243,243,243,243,243, 75, 75,233, 75, 75,232, 75, 75,232, 83, - 85,233, 85, 95,228, 19, 19,186,255,255,255,255,255,255,255,255,255, - 37, 37,193, 82, 86,233, 87, 89,245, 73, 73,244, 73, 73,243, 74, 74, - 243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243, - 243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243, - 243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243,243, - 243, 73, 73,234, 72, 72,233, 73, 73,233, 87, 90,235, 69, 76,223, 40, - 40,193,255,255,255,255,255,255,255,255,255, 77, 77,205, 53, 56,223, - 97, 99,247, 72, 72,246, 71, 71,245, 71, 71,245, 71, 71,244, 71, 71, - 243, 72, 72,243, 72, 72,243, 71, 71,242, 71, 71,241, 71, 71,241, 71, - 71,240, 72, 72,240, 72, 72,240, 71, 71,239, 71, 71,239, 71, 71,238, - 71, 71,237, 71, 71,236, 71, 71,237, 71, 71,236, 71, 71,236, 71, 71, - 235, 71, 71,234, 94, 99,237, 44, 49,214, 81, 81,204,255,255,255,255, - 255,255,255,255,255,165,165,228, 29, 30,203,113,118,250, 71, 71,247, - 71, 71,247, 71, 71,246, 71, 71,246, 70, 70,245, 70, 70,245, 70, 70, - 244, 70, 70,244, 70, 70,243, 70, 70,242, 69, 69,242, 69, 69,242, 69, - 69,241, 69, 69,240, 70, 70,240, 70, 70,239, 69, 69,239, 69, 69,239, - 69, 69,238, 69, 69,237, 69, 69,237, 70, 70,236, 69, 69,236,108,116, - 241, 25, 26,198,170,170,229,255,255,255,255,255,255,255,255,255,240, - 240,250, 10, 10,184,116,121,249, 77, 78,249, 71, 71,249, 71, 71,248, - 71, 71,248, 71, 71,247, 71, 71,246, 71, 71,246, 71, 71,246, 70, 70, - 245, 70, 70,244, 70, 70,244, 70, 70,243, 70, 70,243, 70, 70,242, 69, - 69,242, 69, 69,241, 69, 69,241, 69, 69,240, 69, 69,239, 68, 68,239, - 68, 68,239, 68, 68,239, 74, 75,239,106,115,240, 11, 11,183,241,241, - 251,255,255,255,255,255,255,255,255,255,255,255,255, 89, 89,208, 45, - 46,223,106,109,252, 71, 71,250, 71, 71,250, 71, 71,250, 71, 71,249, - 71, 71,248, 71, 71,248, 71, 71,247, 71, 71,247, 71, 71,246, 71, 71, - 246, 70, 70,245, 70, 70,245, 70, 70,244, 70, 70,243, 70, 70,243, 70, - 70,242, 69, 69,242, 69, 69,242, 69, 69,241, 69, 69,240, 69, 69,240, - 100,107,242, 43, 45,215, 93, 93,209,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,230,230,247, 17, 17,189,111,115,250, 85, - 86,252, 72, 72,252, 71, 71,251, 71, 71,251, 71, 71,250, 71, 71,250, - 71, 71,249, 71, 71,249, 71, 71,248, 71, 71,247, 71, 71,247, 71, 71, - 246, 71, 71,246, 71, 71,246, 70, 70,245, 70, 70,244, 70, 70,244, 70, - 70,243, 70, 70,242, 69, 69,242, 81, 83,242,104,111,241, 18, 18,188, - 232,232,248,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,120,120,217, 27, 28,206,122,126,254, 79, 79,253, 72, - 72,253, 72, 72,253, 72, 72,252, 71, 71,251, 71, 71,251, 71, 71,250, - 71, 71,250, 71, 71,250, 71, 71,249, 71, 71,248, 71, 71,248, 71, 71, - 247, 71, 71,246, 71, 71,246, 71, 71,246, 70, 70,245, 70, 70,245, 75, - 76,245,117,124,247, 28, 29,202,123,123,217,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,252,252, - 254, 55, 55,198, 44, 44,218,121,124,254, 79, 80,254, 72, 72,254, 72, - 72,253, 72, 72,253, 72, 72,253, 72, 72,252, 72, 72,252, 71, 71,251, - 71, 71,250, 71, 71,250, 71, 71,250, 71, 71,249, 71, 71,249, 71, 71, - 248, 71, 71,247, 71, 71,247, 78, 79,247,115,122,248, 43, 45,214, 59, - 59,199,252,252,254,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,238,238,250, 28, 28, - 189, 45, 45,216,125,127,254, 86, 88,254, 72, 72,254, 72, 72,254, 72, - 72,254, 72, 72,254, 72, 72,253, 72, 72,253, 72, 72,253, 72, 72,252, - 71, 71,251, 71, 71,251, 71, 71,250, 71, 71,250, 71, 71,250, 86, 87, - 250,120,126,250, 43, 45,213, 29, 29,189,240,240,250,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,234,234,249, 50, 50,196, 30, 30, - 204,115,117,248,111,114,254, 80, 81,254, 72, 72,254, 72, 72,254, 72, - 72,254, 72, 72,254, 72, 72,254, 72, 72,253, 72, 72,253, 72, 72,253, - 72, 72,252, 81, 82,252,109,113,252,111,116,246, 28, 29,201, 52, 52, - 196,235,235,249,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,249,249,253,105,105,212, 10, 10,184, 53, 54, - 218,122,124,251,117,120,254, 99,100,254, 88, 89,254, 82, 82,254, 77, - 78,254, 82, 82,254, 87, 89,254, 98,100,254,115,119,254,119,123,251, - 50, 51,216, 12, 12,185,105,105,212,250,250,253,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,218,218,244, 74, 74,203, 11, 11,183, 35, 35, - 204, 68, 69,227, 92, 94,239,110,111,246,123,126,252,109,111,246, 91, - 93,238, 67, 68,227, 34, 34,204, 9, 9,183, 77, 77,204,219,219,244, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,237,237,250,162,162,227, 75, 75,204, 38, 38, - 193, 17, 17,186, 4, 4,180, 17, 17,186, 38, 38,194, 77, 77,205,164, - 164,228,238,238,250,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255); - -Const - stdimg_menu_save_all_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,202,138, - 97,195,132, 88,211,139,104,225,143,112,220,141,108,218,139,109,215, - 138,110,205,139,108,171,109, 68,166, 95, 46,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,198,131, 85,239,206, - 186,221,255,255,135,238,199,162,244,215,162,246,215,140,238,199,224, - 255,255,221,162,133,171,106, 62,255,255,255,255,255,255,255,255,255, - 255,255,255,208,153,117,203,148,110,195,127, 81,239,182,154,234,243, - 232, 81,191,132,111,201,152,113,201,153, 84,191,132,228,244,233,221, - 156,123,170,105, 58,255,255,255,255,255,255,255,255,255,255,255,255, - 205,147,107,241,212,195,196,129, 84,234,182,151,243,243,234,237,241, - 230,239,241,230,239,240,230,237,241,229,243,245,237,213,156,121,176, - 112, 68,255,255,255,255,255,255,213,163,131,208,158,123,199,131, 88, - 238,180,153,201,139, 97,230,181,146,226,167,129,225,167,129,222,163, - 125,220,161,123,219,159,121,217,158,119,212,154,115,187,126, 87,255, - 255,255,255,255,255,210,157,121,242,216,201,201,145,106,225,190,159, - 202,141,101,234,184,153,221,165,126,221,166,128,219,163,124,217,160, - 122,217,160,121,216,159,120,216,158,120,191,132, 93,255,255,255,255, - 255,255,208,154,118,242,197,175,205,153,115,215,184,148,200,136, 93, - 239,191,161,253,252,250,254,252,251,254,253,253,254,253,252,253,251, - 250,253,252,251,221,168,133,193,127, 83,255,255,255,255,255,255,208, - 156,120,238,197,173,207,155,119,235,192,164,199,134, 91,239,192,158, - 255,255,255,204,147,110,255,255,255,255,255,255,255,251,247,255,248, - 241,228,175,140,199,138, 97,255,255,255,255,255,255,212,164,130,235, - 197,169,204,142,101,238,190,161,204,141,101,243,205,176,255,255,255, - 227,199,179,255,255,255,255,255,255,255,255,255,255,255,255,234,191, - 161,201,137, 96,255,255,255,255,255,255,213,165,134,238,199,175,202, - 140, 99,237,191,158,212,151,110,212,158,123,208,152,113,214,164,130, - 205,142,104,205,144,105,208,154,117,209,153,115,200,139, 98,238,220, - 208,255,255,255,255,255,255,212,161,127,242,205,181,210,156,121,244, - 211,186,255,255,255,231,206,189,255,255,254,255,255,255,251,246,242, - 248,241,237,237,199,173,208,152,117,255,255,255,255,255,255,255,255, - 255,255,255,255,211,160,126,242,205,179,218,165,129,212,160,126,214, - 166,131,219,176,146,211,157,123,211,158,123,211,159,123,209,154,117, - 207,154,118,240,225,214,255,255,255,255,255,255,255,255,255,255,255, - 255,215,165,134,246,216,193,255,255,255,233,211,195,255,255,255,255, - 255,255,255,255,255,255,255,255,238,205,181,212,162,130,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,221,173, - 141,221,179,151,218,174,143,223,183,156,216,166,136,216,168,137,218, - 175,146,219,175,145,212,164,131,241,227,217,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_btn_ok_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,247,250, - 247,249,251,249,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,247,250,248, 55,131, 61, 52,125, - 58,249,251,249,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,248,251,248, 64,142, 71, 84,163, 92, 79,159, 87, 51,125, - 57,248,251,249,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,248,251,248, - 73,154, 81, 91,172,100,119,202,130,116,200,126, 81,160, 89, 52,126, - 58,248,251,249,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,248,252,249, 81,166, 90, 99,181,109, - 126,206,137,123,204,135,118,202,129,118,201,129, 82,162, 90, 53,127, - 59,249,251,249,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,249,252,250, 89,176, 99,107,189,118,132,210,144,122,201,133, - 96,178,106, 99,180,109,120,201,131,120,203,130, 83,163, 92, 54,128, - 60,249,251,249,255,255,255,255,255,255,255,255,255,255,255,255,211, - 236,214,108,189,118,121,201,134,128,206,141, 83,167, 92,178,214,181, - 156,201,160, 92,173,103,124,204,134,121,203,133, 84,164, 93, 55,129, - 61,249,251,249,255,255,255,255,255,255,255,255,255,255,255,255,217, - 239,220,108,189,117,109,192,121,181,219,185,255,255,255,255,255,255, - 152,199,157, 94,174,104,125,205,137,124,205,135, 86,165, 95, 56,130, - 62,249,251,249,255,255,255,255,255,255,255,255,255,255,255,255,213, - 237,216,190,226,195,255,255,255,255,255,255,255,255,255,255,255,255, - 153,200,157, 95,175,105,127,206,138,126,206,137, 87,166, 96, 57,131, - 63,249,251,249,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 153,200,158, 96,176,106,129,207,141,127,207,139, 88,167, 97, 57,133, - 64,249,251,249,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 153,201,158, 98,178,108,130,209,143,122,200,133, 87,166, 96,159,196, - 162,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 154,202,159, 99,179,109, 95,175,105,165,203,169,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 154,202,159,165,206,169,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_folder_new_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 198,167,146,138, 78, 37,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, - 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, - 74, 32,135, 74, 32,135, 74, 32,138, 78, 37,198,169,148,138, 78, 37, - 217,181,149,221,186,154,221,186,154,221,186,154,221,186,154,221,186, - 154,221,186,154,221,186,154,221,186,154,221,186,154,221,186,154,221, - 186,154,221,186,154,217,181,149,138, 79, 37,135, 74, 32,223,192,162, - 213,172,134,213,172,134,213,172,134,213,172,134,213,172,134,213,172, - 134,213,172,134,213,172,134,212,172,134,212,172,134,212,172,134,213, - 172,134,223,192,162,135, 74, 32,135, 74, 32,226,197,170,215,175,138, - 215,175,138,215,175,138,215,175,138,215,175,138,215,175,138,213,175, - 138,210,177,142,207,178,144,206,178,145,207,178,144,212,176,140,224, - 197,170,135, 74, 32,135, 74, 32,228,202,177,217,179,143,217,179,143, - 217,179,143,217,179,143,217,179,143,213,180,145,196,186,158,180,192, - 170,164,199,184,163,199,184,170,197,179,188,190,165,212,205,184,133, - 78, 38,135, 74, 32,230,205,181,217,179,143,217,179,143,217,179,143, - 217,179,143,212,180,146,187,190,165,144,206,198, 9,212,234, 95,222, - 232, 95,223,233, 10,212,236,128,212,211,169,216,209,124,104, 74,135, - 74, 32,231,207,184,217,179,143,217,179,143,217,179,143,214,179,144, - 192,188,161,139,206,200, 7,212,235,234,251,252, 4,212,237, 4,212, - 237,234,251,253, 7,212,237,111,226,235,107,153,141,135, 74, 32,232, - 210,188,217,179,143,217,179,143,216,179,143,208,182,149,165,197,181, - 89,219,229, 4,212,237,252,254,254,230,250,252,230,250,252,231,250, - 252, 4,213,237, 78,228,246, 92,189,192,136, 76, 34,230,209,188,234, - 212,192,234,212,192,233,212,192,216,214,198,146,220,221, 63,222,240, - 2,212,237,231,251,253,230,250,253,230,250,253,230,249,252, 1,212, - 237, 57,225,245, 86,202,209,139, 77, 36,136, 76, 34,135, 74, 32,135, - 74, 32,134, 74, 32,127, 92, 57, 97,161,154, 3,211,236,230,250,252, - 230,250,253,230,250,253,230,250,253,230,250,253,230,250,252, 4,213, - 237, 84,197,202,135, 74, 32,204,164,133,188,136, 95,188,136, 94,187, - 136, 94,178,143,106,123,167,154, 3,210,234,231,250,252,230,250,253, - 230,250,253,230,250,253,230,250,253,230,250,252, 4,213,236, 93,177, - 176,135, 74, 32,209,176,151,218,186,158,205,161,124,205,161,123,200, - 163,127,178,196,180, 8,210,233, 1,211,236, 0,212,237,237,251,253, - 237,251,253, 0,212,237, 1,212,237, 6,210,233,146,193,189,225,210, - 200,144, 89, 49,218,191,169,236,217,200,236,217,200,236,217,200,203, - 194,176,108,139,122, 80,218,232, 33,218,241, 0,212,237, 0,212,237, - 25,218,241, 70,227,245,157,241,251,231,252,254,255,255,255,225,210, - 200,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,134, 75, 33,207, - 211,204,190,245,252,129,235,248, 95,229,246, 90,229,246,118,234,248, - 183,244,252,234,252,254,253,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_edit_paste_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,155,181,197, 18, 80,118, 1, 68,108, 1, 68, - 108, 1, 68,108, 1, 68,108, 1, 68,108, 1, 68,108, 1, 68,108, 1, - 68,108, 1, 68,108, 1, 68,108, 19, 80,117,162,186,201,255,255,255, - 251,252,253, 13, 76,115, 35,127,186, 59,125,167,100,111,115,104,108, - 106,104,108,106,104,108,106,104,108,106,104,108,106, 61,124,163, 61, - 124,163, 61,124,163, 34,123,179, 16, 78,116,253,254,254,239,243,246, - 9, 74,114, 38,135,197, 99,109,112,237,238,237,254,254,254,254,254, - 254,254,254,254,238,239,239,253,254,254,100,105,103, 39,135,197, 39, - 135,197, 39,135,197, 3, 68,108,247,249,250,239,243,246, 9, 74,114, - 38,135,197,100,104,102,255,255,255,228,231,231,213,216,216,190,194, - 193,180,183,183,255,255,255,255,255,255,100,105,103, 39,135,197, 40, - 134,194, 3, 68,108,247,249,250,239,243,246, 9, 74,114, 38,135,197, - 100,104,102,255,255,255,231,233,233,229,231,231,214,217,217,182,185, - 185,255,255,255,255,255,255,255,255,255,100,105,103, 40,134,194, 3, - 68,108,247,249,250,239,243,246, 9, 75,114, 38,135,197,100,104,102, - 255,255,255,234,236,236,232,234,234,230,232,232,203,206,205,182,186, - 185,181,185,184,255,255,255,100,105,103, 40,134,194, 3, 68,108,247, - 249,250,239,243,246, 9, 75,114, 38,135,197,100,104,102,255,255,255, - 237,238,238,235,236,236,233,235,235,231,233,233,216,218,218,202,205, - 204,255,255,255,100,105,103, 40,134,194, 3, 68,108,247,249,250,239, - 243,246, 9, 75,114, 38,135,197,100,104,102,255,255,255,239,240,240, - 238,239,239,236,237,237,234,235,235,232,234,234,217,219,219,255,255, - 255,100,105,103, 40,134,194, 3, 68,108,247,249,250,239,243,246, 9, - 75,114, 38,135,197,100,104,102,255,255,255,239,240,240,181,181,179, - 181,181,179,180,180,178,178,178,177,232,234,234,255,255,255,100,105, - 103, 40,134,194, 3, 68,108,247,249,250,239,243,246, 9, 75,115, 38, - 135,197,100,104,102,255,255,255,239,240,240,239,240,240,239,240,240, - 239,240,240,237,239,239,235,237,237,255,255,255,100,105,103, 40,134, - 194, 3, 68,108,247,249,250,239,243,246, 9, 75,115, 38,135,197,100, - 104,102,255,255,255,239,240,240,181,181,179,181,181,179,181,181,179, - 181,181,179,238,239,239,255,255,255,100,105,103, 40,134,194, 3, 68, - 108,247,249,250,239,243,246, 9, 75,115, 39,136,198,100,104,102,255, - 255,255,239,240,240,239,240,240,239,240,240,239,240,240,239,240,240, - 239,240,240,255,255,255,100,105,103, 40,134,194, 3, 68,108,247,249, - 250,239,243,246, 9, 75,115, 39,136,198,100,111,113,241,241,241,224, - 224,224,187,187,187,187,187,187,187,187,187,187,187,187,224,224,224, - 242,242,242,100,109,110, 39,135,197, 3, 68,108,247,249,250,251,252, - 253, 13, 77,116, 36,132,192, 62,126,164,100,109,112, 94, 94, 94,124, - 127,127,125,128,128,125,128,128,123,126,126, 94, 94, 94,100,108,110, - 64,124,161, 35,127,185, 16, 78,117,253,254,254,255,255,255,155,182, - 197, 18, 80,119, 1, 68,108, 3, 68,107, 91, 92, 92,137,149,149,138, - 151,151,138,151,151,137,149,149, 91, 92, 92, 3, 68,107, 1, 68,108, - 19, 81,118,162,186,201,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,254,254,254,137,138,138, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 92, 92,137,138,138,254,254,254,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_dialog_confirmation_32 : Array[0..3125] of byte = ( - 66, 77, 54, 12, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 32, 0, 0, 0, 32, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 12, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,252,252,252,247,247,247,239,239,239,232, - 232,232,224,224,224,220,220,220,215,215,215,213,213,213,215,215,215, - 218,218,218,224,224,224,230,230,230,238,238,238,245,245,245,251,251, - 251,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,253,253,253,242,242,242,228,228, - 228,217,217,217,206,205,205,181,166,156,159,124, 99,146, 97, 62,141, - 86, 49,138, 80, 39,138, 80, 39,141, 86, 48,145, 95, 60,154,119, 94, - 172,157,147,191,190,190,201,201,201,210,210,210,222,222,222,238,238, - 238,251,251,251,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 248,248,248,235,235,235,222,222,222,204,201,198,165,132,109,139, 83, - 43,163,116, 84,201,171,149,228,212,200,238,229,221,246,240,236,246, - 241,236,239,229,222,229,214,202,203,174,152,163,117, 84,139, 82, 43, - 155,123, 99,185,182,179,201,201,201,214,214,214,226,226,226,244,244, - 244,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,245,245,245,231,231,231, - 183,157,139,140, 85, 45,184,146,120,236,226,217,252,250,248,252,250, - 249,252,250,249,252,250,249,252,250,249,252,250,249,252,250,249,252, - 250,249,252,250,249,252,250,249,238,228,220,187,151,124,140, 84, 45, - 171,145,128,210,210,210,223,223,223,236,236,236,253,253,253,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,250,248,247,171,131,102,165,119, 87,234,222,213, - 252,250,248,252,250,248,238,228,220,217,193,174,200,166,137,195,155, - 124,189,147,111,190,148,113,198,160,128,205,170,143,221,197,179,240, - 230,223,252,250,249,252,250,249,236,225,216,167,122, 89,165,125, 96, - 231,229,228,246,246,246,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,252,251,250,160, - 112, 78,186,150,123,248,244,241,252,250,248,237,226,218,199,165,138, - 181,134, 97,184,139,102,187,142,106,190,146,110,192,148,112,193,150, - 114,193,151,115,193,150,115,192,149,113,190,147,111,207,175,149,240, - 230,222,252,250,249,249,245,242,190,155,129,161,113, 80,252,251,250, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,254,254,173,131,102,186,150,124,251,249,247,252, - 250,248,219,198,181,178,131, 94,180,133, 96,184,138,102,187,143,107, - 191,147,111,193,151,115,196,154,118,197,156,121,198,157,122,198,156, - 121,196,155,119,194,152,117,192,149,113,191,147,111,225,205,189,252, - 250,249,252,250,248,190,155,130,174,132,103,255,254,254,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,201,173, - 154,174,131,101,249,246,243,251,249,248,206,177,154,174,125, 87,178, - 131, 94,183,136,100,187,142,105,190,147,111,194,151,116,229,226,224, - 230,228,225,230,228,225,230,228,226,202,162,127,201,160,125,198,157, - 122,195,153,118,192,149,113,188,144,107,214,187,166,252,250,249,250, - 247,245,177,136,106,201,173,154,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,247,242,239,149, 94, 57,238,228,221,251,249, - 248,213,188,169,171,122, 83,176,127, 90,180,133, 96,185,139,102,189, - 145,109,193,150,114,197,155,120,232,232,232,233,233,233,234,234,234, - 234,234,234,206,168,134,205,165,131,202,162,127,198,157,122,194,152, - 117,190,147,111,186,141,105,220,197,179,252,250,249,240,231,225,150, - 96, 59,247,242,239,255,255,255,255,255,255,255,255,255,255,255,255, - 183,145,120,194,163,139,251,249,248,232,218,208,169,119, 80,172,123, - 85,177,129, 91,182,135, 98,186,141,105,191,147,111,195,153,117,199, - 158,124,234,234,234,235,235,235,236,236,236,236,236,236,211,173,140, - 208,170,136,205,166,131,201,160,126,197,155,120,192,149,113,188,143, - 107,184,138,102,236,223,214,252,250,248,199,169,147,183,146,121,255, - 255,255,255,255,255,255,255,255,249,246,245,144, 87, 48,243,236,231, - 251,249,247,183,142,110,168,118, 79,173,124, 86,178,130, 93,182,136, - 99,187,142,106,192,148,113,196,155,119,201,161,126,234,231,229,235, - 232,230,236,234,232,236,234,232,215,178,146,211,174,141,207,169,135, - 203,163,128,198,157,122,193,151,115,189,145,108,184,139,102,195,158, - 128,252,249,248,245,238,234,144, 88, 49,249,246,245,255,255,255,255, - 255,255,215,194,180,176,134,105,251,249,247,229,215,205,164,112, 73, - 169,118, 80,173,124, 86,178,131, 93,183,137,100,188,143,107,192,149, - 113,197,155,120,202,162,127,206,168,134,211,174,141,216,180,147,220, - 186,153,217,182,150,213,176,143,208,170,136,203,164,130,199,158,123, - 194,151,116,189,145,109,185,139,102,180,133, 96,234,221,211,252,250, - 248,179,139,110,215,194,180,255,255,255,255,255,255,171,127, 98,209, - 184,166,251,249,247,200,169,146,164,112, 73,169,118, 79,173,124, 86, - 178,130, 93,183,137,100,187,143,106,192,149,113,197,155,120,201,161, - 127,239,239,239,241,241,241,242,242,242,242,242,242,217,183,152,212, - 175,142,208,170,136,203,163,129,199,157,122,194,151,116,189,145,109, - 184,139,102,180,133, 95,209,181,159,252,250,248,213,190,173,172,129, - 99,255,255,255,255,255,255,147, 92, 55,231,218,209,251,249,247,180, - 139,107,163,111, 72,168,117, 79,173,124, 85,177,130, 92,182,136, 99, - 187,142,105,191,148,112,196,154,119,200,160,125,236,230,225,242,242, - 242,243,243,243,244,244,244,227,206,188,210,172,139,206,167,133,202, - 162,127,197,156,121,193,150,114,188,144,108,184,138,101,179,132, 95, - 192,155,125,252,250,248,234,222,214,148, 93, 56,255,255,255,255,255, - 255,138, 79, 37,242,235,230,251,249,247,170,122, 87,163,110, 71,167, - 116, 78,172,122, 84,176,128, 91,181,134, 97,185,140,104,190,146,110, - 194,152,116,198,157,122,217,191,170,244,244,244,245,245,245,246,246, - 246,244,244,244,219,193,170,203,164,130,200,159,124,196,154,118,191, - 148,112,187,142,106,183,137,100,178,131, 93,184,141,107,252,250,248, - 244,238,233,139, 79, 38,255,255,255,255,255,255,138, 78, 37,251,249, - 247,251,249,247,162,110, 72,162,109, 69,166,115, 76,171,121, 82,175, - 127, 89,179,132, 95,184,138,101,188,143,107,192,149,113,196,154,118, - 199,158,123,224,204,186,247,247,247,248,248,248,247,247,247,244,244, - 244,216,191,169,197,155,120,193,150,115,189,145,109,185,140,103,181, - 134, 97,177,129, 91,176,129, 93,252,250,248,251,249,248,138, 79, 38, - 255,255,255,255,255,255,138, 79, 37,242,235,230,251,249,247,168,120, - 85,160,107, 67,165,113, 74,169,119, 80,173,124, 86,177,130, 92,181, - 135, 98,185,140,104,189,145,109,192,149,114,195,153,118,198,157,122, - 222,200,181,249,249,249,249,249,249,247,247,247,243,243,242,206,173, - 146,190,147,111,187,142,106,183,137,100,179,132, 94,175,126, 88,180, - 137,103,252,250,248,244,237,233,138, 79, 37,255,255,255,255,255,255, - 147, 92, 54,230,217,208,251,249,247,177,134,103,158,105, 65,163,110, - 71,167,116, 77,171,121, 83,175,127, 89,179,132, 94,183,136,100,186, - 141,104,189,145,109,192,148,113,194,151,116,195,153,118,226,207,192, - 250,250,250,248,248,248,245,245,245,229,218,209,187,143,106,184,138, - 101,180,134, 96,177,129, 91,173,123, 85,187,149,118,251,249,248,233, - 221,212,148, 93, 55,255,255,255,255,255,255,170,127, 97,207,181,164, - 251,249,247,196,164,140,156,102, 62,161,108, 68,165,113, 74,169,118, - 79,172,123, 85,176,128, 90,179,132, 95,189,148,116,185,140,104,188, - 143,107,190,146,110,191,147,111,199,162,131,251,251,251,249,249,249, - 246,246,246,240,239,237,184,138,101,181,134, 97,177,130, 92,174,125, - 87,170,120, 82,204,174,152,251,249,248,211,187,170,171,128, 98,255, - 255,255,255,255,255,215,194,180,173,132,102,251,248,247,227,212,201, - 154, 99, 59,158,105, 65,162,110, 70,166,115, 76,170,119, 81,173,124, - 86,176,128, 90,238,237,236,219,200,185,195,157,127,185,140,103,186, - 141,106,217,193,173,252,252,252,249,249,249,246,246,246,240,237,235, - 180,133, 96,177,130, 92,174,126, 88,171,121, 83,167,116, 78,231,217, - 206,251,249,248,176,136,107,215,194,180,255,255,255,255,255,255,249, - 246,245,143, 87, 47,242,234,229,250,248,246,173,129, 97,156,101, 61, - 159,106, 66,163,111, 71,166,115, 76,170,120, 81,173,123, 85,240,240, - 240,243,243,243,245,245,245,245,243,241,247,245,243,252,252,252,251, - 251,251,248,248,248,245,245,245,221,206,193,176,128, 90,174,125, 87, - 171,121, 83,168,117, 78,183,143,111,251,249,247,243,236,232,144, 88, - 48,249,246,245,255,255,255,255,255,255,255,255,255,181,144,118,190, - 157,133,251,248,247,228,214,203,154,100, 59,156,102, 62,160,107, 67, - 163,111, 72,166,115, 76,169,119, 80,239,239,239,242,242,242,245,245, - 245,247,247,247,249,249,249,250,250,250,249,249,249,247,247,247,237, - 232,227,182,141,108,172,123, 85,170,120, 81,167,116, 78,165,115, 75, - 231,218,208,251,249,248,194,163,140,182,145,119,255,255,255,255,255, - 255,255,255,255,255,255,255,246,242,238,147, 92, 54,235,225,217,251, - 248,247,204,177,158,153, 98, 58,157,103, 62,160,107, 67,163,110, 71, - 165,114, 75,186,150,121,208,184,166,228,216,207,238,233,229,247,246, - 245,243,240,238,232,222,215,209,184,165,176,129, 94,170,120, 82,168, - 118, 79,166,115, 76,164,112, 72,210,184,165,251,249,248,237,227,220, - 148, 93, 56,246,242,238,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,200,172,153,170,127, 96,248,244,242,251,249,247,194, - 162,138,153, 98, 57,156,102, 62,159,105, 65,161,109, 69,163,111, 72, - 165,114, 75,167,116, 77,168,117, 78,169,118, 79,169,119, 80,169,118, - 80,168,118, 79,167,116, 78,166,115, 76,164,112, 73,162,110, 70,200, - 169,146,251,249,247,249,245,243,172,130,100,201,173,154,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,254, - 254,172,130,101,181,143,116,250,248,246,251,249,247,209,184,167,154, - 101, 61,155,100, 60,157,103, 63,159,106, 66,161,108, 69,162,110, 71, - 163,111, 72,164,112, 73,164,113, 73,164,113, 73,164,112, 73,163,111, - 71,162,109, 69,162,110, 71,213,189,172,251,249,247,251,248,247,184, - 147,121,172,131,101,255,254,254,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,252,251,250,157,107, - 73,181,142,115,246,242,238,251,248,247,232,219,210,180,140,110,153, - 98, 58,155,101, 60,157,103, 63,158,104, 64,159,106, 66,160,106, 67, - 160,107, 67,160,107, 67,159,106, 66,158,105, 65,185,146,117,233,221, - 212,251,249,247,247,243,239,183,145,119,158,108, 74,252,251,250,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,251,249,248,174,132,103,163,115, - 82,229,215,205,251,248,247,251,249,247,232,220,211,202,173,152,177, - 134,103,167,120, 84,159,105, 66,159,106, 67,168,122, 87,179,137,106, - 204,175,155,233,221,213,251,249,247,251,249,247,230,217,208,165,117, - 85,175,133,104,251,249,248,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,203,176,159,142, 85, 46,177,136, - 109,231,218,209,251,248,247,251,249,247,251,249,247,251,249,247,251, - 249,247,251,249,247,251,249,247,251,249,247,251,249,247,251,249,247, - 232,220,211,179,139,112,142, 85, 46,204,177,159,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,247,244,241,189,155,133,142, 84, 45,161,112, - 79,191,157,135,220,201,188,233,221,212,242,235,231,242,235,231,233, - 221,213,220,202,189,192,159,137,162,114, 80,142, 84, 45,189,155,133, - 247,244,241,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,253,252,252,224,209,198,184,149,124,156,106, - 71,146, 92, 53,139, 81, 40,139, 81, 40,146, 92, 53,156,106, 71,184, - 149,125,224,209,198,253,252,252,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255); - -Const - stdimg_list_remove_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0,215, 13, 0, 0,215, 13, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,182,132, 93,164,101, 52,164,101, 52, - 164,101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, - 52,164,101, 52,164,101, 52,182,132, 93,255,255,255,255,255,255,255, - 255,255,255,255,255,164,101, 52,229,204,180,219,183,149,219,182,148, - 218,180,146,218,179,144,217,173,134,216,170,131,215,168,127,215,166, - 125,224,190,159,164,101, 52,255,255,255,255,255,255,255,255,255,255, - 255,255,164,101, 52,232,211,192,231,209,187,231,209,188,230,206,183, - 230,206,183,230,206,183,230,206,183,230,205,182,230,204,181,230,204, - 182,164,101, 52,255,255,255,255,255,255,255,255,255,255,255,255,182, - 132, 93,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52, - 164,101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52,182,132, - 93,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_arrow_right : Array[0..89] of byte = ( - 66, 77, 90, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 40, 0, 0, - 0, 4, 0, 0, 0, 7, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, - 28, 0, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 2, 0, 0, 0, 2, - 0, 0, 0, 0, 0, 0, 0,255,255,255, 0,112, 0, 0, 0, 48, 0, - 0, 0, 16, 0, 0, 0, 0, 0, 0, 0, 16, 0, 0, 0, 48, 0, 0, - 0,112, 0, 0, 0); - -Const - stdimg_choice_yes_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,194,228,199, 12,164, 60, 17,171, 71, 13,173, 73,104,175, - 120,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 87,183,107, 78,224,155, 92,234,170, 92,234,171, 35,192,104, 87,167, - 106,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,234,244,235, 32,183, 89, - 102,255,205,104,255,201, 85,255,195, 73,252,184, 24,199,107, 85,166, - 102,254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,157,207,165, 22,223,131, 47,255,181, - 45,255,174, 30,255,170, 3,255,160, 17,250,157, 12,190, 93, 68,158, - 86,252,253,252,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255, 68,173, 91, 0,248,147, 1,254,156, 10,254,160, - 18,251,159, 38,250,165, 49,242,160, 70,234,157, 21,183, 87, 74,169, - 94,247,251,247,255,255,255,255,255,255,255,255,255,255,255,255,224, - 238,224, 7,173, 65, 7,243,144, 45,243,160, 72,243,171,105,199,139, - 96,231,164,112,241,183,110,233,172,102,224,157, 28,169, 74, 57,157, - 75,242,248,242,255,255,255,255,255,255,255,255,255,148,199,148, 18, - 202,101, 79,235,162,102,241,178, 85,205,129,252,253,252,172,211,180, - 89,192,126,129,232,178,130,225,170,129,215,157, 45,168, 78, 63,165, - 77,238,246,238,255,255,255,255,255,255,127,196,134, 86,221,149,112, - 231,171,111,233,173,152,207,158,255,255,255,255,255,255,210,233,211, - 101,183,121,151,227,181,150,221,173,157,217,170, 60,168, 84, 44,152, - 56,229,241,229,255,255,255,237,246,237,138,190,142, 97,180,115, 81, - 180,107,226,240,226,255,255,255,255,255,255,255,255,255,212,232,212, - 109,181,120,173,225,187,170,219,179,181,219,181, 84,174,101, 42,147, - 51,214,234,214,255,255,255,255,255,255,252,253,252,229,242,229,254, - 254,254,255,255,255,255,255,255,255,255,255,255,255,255,224,239,224, - 121,181,123,195,228,198,191,223,191,206,230,203,110,184,122,115,185, - 121,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,225,239,225, - 126,181,126,218,237,218,228,242,228,169,210,169,173,204,172,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,235,244,235, - 115,168,114,139,187,139,195,215,194,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_arrow_left : Array[0..89] of byte = ( - 66, 77, 90, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 40, 0, 0, - 0, 4, 0, 0, 0, 7, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, - 28, 0, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 2, 0, 0, 0, 2, - 0, 0, 0, 0, 0, 0, 0,255,255,255, 0,224, 0, 0, 0,192, 0, - 0, 0,128, 0, 0, 0, 0, 0, 0, 0,128, 0, 0, 0,192, 0, 0, - 0,224, 0, 0, 0); - -Const - stdimg_refresh_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,197,157,126,255,254,254,255,255,255,255,255, - 255,253,252,251,225,205,189,189,144,108,174,118, 73,166,105, 57,176, - 122, 79,196,156,124,242,233,226,255,255,255,255,255,255,255,255,255, - 255,255,255,164,101, 52,203,167,139,255,255,255,225,204,188,172,113, - 68,184,134, 93,206,166,132,216,182,151,219,185,153,211,172,138,195, - 149,111,169,109, 63,223,200,183,255,255,255,255,255,255,255,255,255, - 165,104, 56,185,136, 96,180,129, 88,180,128, 86,227,202,180,236,218, - 201,231,209,188,227,201,176,222,190,160,210,171,136,206,165,130,211, - 174,142,169,110, 64,240,230,222,255,255,255,255,255,255,167,105, 58, - 241,228,216,212,178,149,244,233,224,243,232,221,237,220,204,210,173, - 143,179,125, 83,166,104, 56,166,105, 57,166,106, 58,169,109, 61,176, - 120, 76,197,157,125,255,255,255,255,255,255,166,104, 57,246,238,230, - 245,236,227,245,237,228,230,210,193,179,126, 84,185,136, 97,236,222, - 212,255,255,255,217,191,171,175,117, 74,182,124, 79,167,107, 59,167, - 107, 59,255,255,255,255,255,255,165,104, 55,246,238,230,235,215,196, - 234,217,201,164,102, 53,217,191,171,255,255,255,255,255,255,255,255, - 255,251,248,246,173,115, 70,225,196,174,200,158,124,164,101, 52,253, - 252,251,255,255,255,165,103, 54,245,237,229,246,237,229,245,236,228, - 215,184,157,177,122, 79,249,245,242,255,255,255,255,255,255,255,255, - 255,255,255,255,251,246,242,244,232,223,165,103, 54,251,248,245,255, - 255,255,166,105, 57,164,102, 53,164,102, 53,165,102, 54,165,103, 54, - 165,103, 55,189,143,108,245,237,232,246,241,236,246,241,236,246,241, - 236,246,241,236,246,241,236,245,238,233,255,255,255,255,255,255,250, - 247,245,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,198,158,128,164,101, 52,175,120, 76,178,123, 82,178,123, - 82,178,124, 82,164,101, 52,252,250,249,255,255,255,165,103, 54,217, - 189,167,247,238,232,250,246,242,254,254,253,255,255,255,255,255,255, - 254,253,252,187,139,102,209,174,145,246,238,231,242,230,219,246,238, - 230,167,108, 61,252,250,248,255,255,255,164,102, 54,168,108, 61,221, - 187,162,174,118, 75,243,234,227,255,255,255,255,255,255,255,255,255, - 221,197,179,164,102, 53,233,215,199,235,216,198,245,236,227,168,109, - 62,251,249,247,255,255,255,170,111, 65,171,112, 65,169,109, 61,170, - 112, 66,213,184,162,246,240,235,230,213,200,183,134, 95,188,141,103, - 235,219,205,245,235,226,246,238,230,246,238,230,169,109, 62,251,248, - 246,255,255,255,202,164,135,192,145,106,197,152,114,168,107, 60,164, - 102, 53,168,108, 60,186,139,101,217,187,161,241,228,216,242,230,219, - 243,232,221,206,168,137,234,216,200,169,110, 63,250,247,245,255,255, - 255,240,230,222,169,111, 65,211,173,140,220,189,157,221,190,161,229, - 203,180,233,211,191,238,221,204,240,226,213,231,210,191,178,124, 82, - 187,141,104,174,117, 73,165,104, 55,250,247,244,255,255,255,255,255, - 255,226,207,192,169,109, 63,193,146,107,211,176,143,223,194,168,222, - 193,168,212,177,147,188,140,102,170,112, 67,224,202,185,255,255,255, - 219,194,174,164,101, 52,250,246,243,255,255,255,255,255,255,255,255, - 255,245,237,232,200,161,132,178,125, 83,168,108, 61,176,120, 77,190, - 145,110,225,205,189,253,252,251,255,255,255,255,255,255,255,255,255, - 212,182,159,249,245,242); - -Const - stdimg_arrow_down : Array[0..77] of byte = ( - 66, 77, 78, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 40, 0, 0, - 0, 7, 0, 0, 0, 4, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, - 16, 0, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 2, 0, 0, 0, 2, - 0, 0, 0, 0, 0, 0, 0,255,255,255, 0,238, 0, 0, 0,198, 0, - 0, 0,130, 0, 0, 0, 0, 0, 0, 0); - -Const - stdimg_font_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,200,200,200,128,128,128,135,135,135,133, - 133,133,133,133,133,128,128,128,202,202,202,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,171,171,171, 88, 88, 88,102,102,102,108,108,108, 99, - 99, 99, 83, 83, 83,176,176,176,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,254,254,254,255,255,255,255,255,255,255,255, - 255,254,254,254,237,237,237, 81, 81, 81, 84, 84, 84, 81, 81, 81,237, - 237,237,252,252,252,255,255,255,255,255,255,255,255,255,255,255,255, - 160,162,180, 60, 77,162, 76, 89,162, 77, 90,161, 74, 87,161, 73, 84, - 156,207,207,209, 80, 80, 77, 45, 45, 45, 74, 74, 74,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,151,154,186, - 36, 59,219, 0, 43,255, 0, 47,255, 0, 39,239, 45, 62,197,204,204, - 209, 65, 65, 63, 7, 7, 7, 60, 60, 60,251,251,251,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,254,254,254,234,234,238, - 19, 38,213, 0, 32,255, 80, 88,168,251,251,251,253,253,253, 55, 55, - 55, 0, 0, 0, 58, 58, 58,251,251,251,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,245,245,245, 28, 37,212, - 0, 16,255, 86, 89,166,255,255,255,254,254,254, 55, 55, 55, 1, 1, - 1, 58, 58, 58,251,251,251,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,242,242,242, 27, 28,213, 0, 3,255, - 85, 85,168,255,255,255,253,253,253, 55, 55, 55, 0, 0, 0, 58, 58, - 58,251,251,251,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,242,242,242, 27, 27,213, 0, 0,255, 84, 84,166, - 255,255,255,253,253,253, 57, 57, 57, 11, 11, 11, 60, 60, 60,251,251, - 251,255,255,255,251,251,251,248,248,248,255,255,255,255,255,255,255, - 255,255,242,242,242, 27, 27,220, 3, 4,166, 62, 62, 88,255,255,255, - 255,255,255, 71, 71, 71, 49, 49, 49, 71, 71, 71,255,255,255,255,255, - 255,100,100,100,127,127,127,255,255,255,255,255,255,255,255,255,242, - 242,242, 27, 27,224, 19, 19,138, 52, 52, 32,195,195,195,239,239,239, - 78, 78, 78, 93, 93, 93, 76, 76, 76,243,243,243,210,210,210, 40, 40, - 40,108,108,108,235,235,235,236,236,236,255,255,255,242,242,242, 29, - 29,225, 24, 24,153,113,113, 93, 65, 65, 65, 71, 71, 71, 84, 84, 81, - 139,139,138, 75, 75, 75, 74, 74, 74, 66, 66, 66,113,113,113,126,126, - 126, 78, 78,167, 88, 88,152,255,255,255,250,250,250, 48, 48,225, 37, - 38,161,103,103, 98,114,114,111,106,106,103,106,106,115,112,112,115, - 111,111,111,105,105,105,113,113,113,113,113,113,140,140,140, 83, 83, - 197, 45, 45,204,189,189,191,214,214,214, 59, 60,212, 81, 83,247, 72, - 72,146,208,208,208,143,143,161, 43, 44,213,125,125,156,226,226,226, - 225,225,225,225,225,225,221,221,221,240,240,240,105,105,181,113,114, - 255, 76, 76,207, 77, 77,191, 97, 98,244,127,128,255, 79, 79,220, 83, - 84,188, 87, 87,223,104,105,255,151,151,176,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,123,123,178, 80, 80,215, 84, 84, - 223, 80, 80,228, 81, 81,220, 74, 74,218, 79, 79,223, 77, 77,228, 83, - 83,239, 67, 68,231,170,170,187,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_edit : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0,235, 10, 0, 0,235, 10, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 98,146, 94, 48, 48, 48, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 98,146, 94, 98,146, 94, - 98,146, 94, 88, 88, 88,220,220,220,255,255,255,255,255,255,255,255, - 255,255,255,255,160,160,160,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255, 0, 0, 0, 98,146, 94, 98,146, 94, 98,146, 94, - 88, 88, 88,220,220,220,160,160,160,160,160,160, 0, 0, 0,160,160, - 160,160,160,160,160,160,160,160,160,160,160,160,160,160,160,160,160, - 160,160, 0, 0, 0, 98,146, 94, 98,146, 94, 98,146, 94, 88, 88, 88, - 220,220,220,255,255,255,255,255,255, 88, 88, 88, 48, 48, 48, 0, 0, - 64,195,195,195,220,220,220,255,255,255,255,255,255,255,255,255, 0, - 0, 0, 98,146, 94, 98,146, 94, 98,146, 94, 88, 88, 88,220,220,220, - 255,255,255,255,255,255,255,255,255, 88, 88, 88,168,220,255, 0, 88, - 192, 0, 88,192,195,195,195,220,220,220,255,255,255, 0, 0, 0, 98, - 146, 94, 98,146, 94, 98,146, 94, 88, 88, 88,220,220,220,195,195,195, - 195,195,195,195,195,195,160,160,160,168,220,255,168,220,255,168,220, - 255, 0, 88,192, 0, 88,192,160,160,160, 0, 0, 0, 98,146, 94, 98, - 146, 94, 98,146, 94, 88, 88, 88,220,220,220,255,255,255,255,255,255, - 255,255,255,255,255,255, 88,168,255,168,220,255,168,220,255,168,220, - 255,168,220,255, 0, 0, 64, 0, 0, 0, 98,146, 94, 98,146, 94, 98, - 146, 94, 88, 88, 88,220,220,220,255,255,255,255,255,255,255,255,255, - 255,255,255,160,160,160,168,220,255,168,220,255, 0,128,255, 0,128, - 255, 0, 88,192, 48, 48, 48, 98,146, 94, 98,146, 94, 98,146, 94, 88, - 88, 88,220,220,220,195,195,195,195,195,195,195,195,195,195,195,195, - 195,195,195, 88,168,255,168,220,255, 0,128,255, 0,128,255, 0,128, - 255, 0, 88,192, 48, 48, 48, 98,146, 94, 98,146, 94, 88, 88, 88,220, - 220,220,255,255,255,255,255,255,255,255,255,255,255,255,195,195,195, - 255,255,255, 88,168,255, 88,168,255, 0,128,255, 0,128,255, 0,128, - 255, 0, 88,192, 0, 0, 64, 98,146, 94, 88, 88, 88,220,220,220,255, - 255,255,255,255,255,255,255,255,255,255,255,195,195,195,255,255,255, - 255,255,255, 88,168,255, 88,168,255, 0,128,255, 0,128,255, 0,128, - 255, 0, 88,192, 98,146, 94, 88, 88, 88,220,220,220,195,195,195,195, - 195,195,195,195,195,195,195,195,195,195,195,195,195,195,195,195,195, - 195,195,195, 88,168,255, 88,168,255, 0,128,255, 0,128,255, 0,128, - 255, 98,146, 94, 88, 88, 88,220,220,220,255,255,255,255,255,255,255, - 255,255,255,255,255,195,195,195,255,255,255,255,255,255,255,255,255, - 255,255,255, 88,168,255, 88,168,255, 0,128,255, 0,128,255, 98,146, - 94, 88, 88, 88,220,220,220,255,255,255,255,255,255,255,255,255,255, - 255,255,195,195,195,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255, 88,168,255, 88,168,255, 0,128,255, 98,146, 94, 88, 88, - 88,220,220,220,220,220,220,220,220,220,220,220,220,220,220,220,220, - 220,220,220,220,220,220,220,220,220,220,220,220,220,220,220,220,220, - 88, 88, 88, 88,168,255, 88,168,255, 98,146, 94, 88, 88, 88, 88, 88, - 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, - 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, - 98,146, 94, 98,146, 94); - -Const - stdimg_menu_quit_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,225,225,225,207,207,208,208,208, - 209,208,208,209,208,208,209,208,208,209,208,208,209,208,208,209,208, - 208,209,208,208,209,207,207,208,221,221,221,255,255,255,255,255,255, - 255,255,255,160,160,178, 31, 31,163, 31, 31,163, 31, 31,163, 31, 31, - 163, 31, 31,163, 31, 31,163, 31, 31,163, 31, 31,163, 31, 31,163, 31, - 31,163, 31, 31,163, 31, 31,163,141,141,166,254,254,254,255,255,255, - 33, 33,176, 6, 5,193, 0, 0,194, 0, 0,201, 0, 0,206, 0, 0, - 217, 24, 24,228, 26, 26,234, 12, 15,235, 6, 12,236, 26, 36,239, 36, - 48,241, 50, 67,251, 42, 47,189,255,255,255,255,255,255, 16, 16,173, - 0, 0,181, 0, 0,190, 0, 0,195,108,108,225,216,216,249,255,255, - 255,255,255,255,227,227,253,133,136,243, 24, 34,233, 31, 43,235, 45, - 60,239, 39, 46,196,255,255,255,255,255,255, 16, 16,170, 0, 0,181, - 1, 1,187,142,142,229,255,255,255,223,223,246,144,144,233,139,139, - 235,212,212,246,255,255,255,173,177,248, 32, 44,235, 42, 57,239, 38, - 45,195,255,255,255,255,255,255, 18, 18,168, 1, 1,179,105,105,214, - 255,255,255,173,173,233, 10, 10,206, 0, 0,213, 0, 0,221, 2, 2, - 224,149,151,238,255,255,255,147,153,246, 29, 43,237, 37, 44,193,255, - 255,255,255,255,255, 23, 23,166, 23, 23,185,211,211,242,246,246,252, - 51, 51,207, 30, 30,212, 31, 31,218, 19, 19,222, 0, 0,227, 7, 10, - 227,228,228,250,235,236,254, 41, 53,238, 34, 40,192,255,255,255,255, - 255,255, 27, 27,164, 51, 51,190,239,239,250,220,220,246, 44, 44,203, - 54, 54,212, 50, 50,217, 54, 54,223, 57, 56,230, 18, 19,230,181,182, - 247,255,255,255, 51, 60,238, 30, 35,190,255,255,255,255,255,255, 31, - 31,163, 58, 58,188,227,227,245,239,239,251, 67, 67,206, 61, 61,210, - 155,155,235,158,158,239, 73, 73,227, 74, 74,233,222,222,252,239,240, - 253, 30, 36,234, 28, 31,189,255,255,255,255,255,255, 36, 36,162, 65, - 65,188,170,170,222,255,255,255,159,159,229, 74, 74,208,238,238,251, - 244,244,253, 84, 84,224,149,149,239,255,255,255,197,197,244, 14, 16, - 231, 22, 23,187,255,255,255,255,255,255, 40, 40,162, 89, 89,193, 97, - 97,194,221,221,238,255,255,255,147,147,224,225,225,247,230,230,249, - 160,160,235,255,255,255,233,233,246,131,131,230, 99, 99,237, 23, 23, - 185,255,255,255,255,255,255, 46, 46,163,107,107,195,100,100,195,113, - 113,198,175,175,215,133,133,212,231,231,248,233,233,250,165,165,225, - 208,208,232,135,135,222,123,123,229,141,141,234, 53, 53,186,255,255, - 255,255,255,255, 55, 55,165,120,120,195,118,118,196,118,118,200,113, - 113,199,123,123,207,241,241,251,246,246,253,131,131,216,128,128,215, - 137,137,224,143,143,225,150,150,229, 68, 68,186,255,255,255,255,255, - 255, 84, 84,167,172,172,222,170,170,219,172,172,222,175,175,225,179, - 179,229,176,176,228,179,179,231,189,189,237,191,191,238,195,195,239, - 197,197,240,209,209,247,163,163,193,255,255,255,255,255,255,187,187, - 224,103,103,175,100,100,172,100,100,171,101,101,172,101,101,172,101, - 101,173,102,102,173,102,102,173,102,102,173,103,103,173,104,104,173, - 104,104,175,198,198,224,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_arrow_up : Array[0..77] of byte = ( - 66, 77, 78, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 40, 0, 0, - 0, 7, 0, 0, 0, 4, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, - 16, 0, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 2, 0, 0, 0, 2, - 0, 0, 0, 0, 0, 0, 0,255,255,255, 0, 0, 0, 0, 0,130, 0, - 0, 0,198, 0, 0, 0,238, 0, 0, 0); - -Const - stdimg_dialog_information_32 : Array[0..3125] of byte = ( - 66, 77, 54, 12, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 32, 0, 0, 0, 32, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 12, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,254, - 254,254,252,252,252,248,248,248,245,245,245,243,243,243,241,241,241, - 239,239,239,239,239,239,241,241,241,243,243,243,245,245,245,249,249, - 249,252,252,252,254,254,254,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,254,254,254,249,249,249,243,243,243,238,238,238,233,233,233,229, - 229,229,223,223,223,216,216,216,201,201,201,198,198,198,207,207,207, - 209,209,209,214,214,214,221,221,221,228,228,228,232,232,232,236,236, - 236,242,242,242,250,250,250,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,254,254,254,248,248,248,242,242, - 242,236,236,236,230,230,230,223,223,223,210,210,210,195,195,195,117, - 117,117, 92, 92, 92, 92, 92, 92,112,112,112,170,170,170,183,183,183, - 194,194,194,206,206,206,218,218,218,229,229,229,234,234,234,240,240, - 240,246,246,246,254,254,254,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,249,249,249,243,243,243,238,238,238,232,232, - 232,226,226,226,215,215,215,154,154,154, 97, 97, 97,185,185,185,185, - 185,185,106,106,106,142,142,142,191,191,191,201,201,201,211,211,211, - 223,223,223,230,230,230,236,236,236,241,241,241,247,247,247,254,254, - 254,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,251,251,251,247,247,247,242,242,242,208,214,214,123,144, - 144, 53, 84, 84, 44, 77, 77, 46, 80, 80, 44, 79, 79, 46, 78, 78, 64, - 90, 90,114,138,138,222,223,223,233,233,233,236,236,236,241,241,241, - 245,245,245,250,250,250,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255, 51, 88, 88, 65,125,125,118,178,177,148,198, - 196,177,224,221,167,213,210,154,203,200, 93,137,136, 63,104,105, 69, - 101,101,242,244,244,252,252,252,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 45, 88, 88, 90,161,161,242,251,250,197,244,242,198,247,244,185,233, - 231,141,183,181,126,169,169, 97,143,145, 49, 89, 89,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,154,174,174, 61,112,112, - 134,166,165,192,241,238,198,247,244,189,239,237,171,223,221, 80,123, - 123, 62,102,102,116,140,140,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255, 57, 95, 95, 71,134,133,193,230,229,186,234,232, - 183,230,227,167,210,209,143,186,186,135,185,185, 97,143,145, 49, 85, - 85,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, 71, - 123,122,111,177,177,183,176,175,132,129,125,118,108,106,115,104,101, - 122,116,113,116,120,118, 85,106,105, 70,101,101,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,129,141,139,118,111,106,181, - 174,170,220,215,211,231,228,225,235,231,228,235,232,230,214,214,211, - 144,139,137,122,117,115,251,250,250,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,229,227,226,131,118,114,218,210,203,206,205,198,145,154,149,167, - 186,181,167,192,189,142,166,166,201,221,219,238,235,233,178,171,168, - 173,166,164,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,149,137,134,221,205, - 197,240,227,218,206,203,194,159,161,158,202,210,206,203,217,215,151, - 161,160,225,233,233,253,250,249,254,243,242,133,121,118,241,240,240, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,245,244,244,127,114,110,244,229,220,238,225,213,218,211, - 205,229,223,218,250,246,242,252,251,248,223,222,222,221,221,220,253, - 251,250,253,244,242,190,178,175,209,205,204,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,214,211,210, - 160,146,140,242,226,214,239,224,213,233,227,220,245,238,232,249,245, - 241,252,249,247,251,250,248,224,224,223,251,249,247,252,245,242,215, - 205,202,183,175,173,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,229,227,226,130,117,114,223,206,194,236,218,203, - 242,231,223,245,236,228,245,237,230,248,243,238,250,247,244,252,249, - 247,248,246,245,252,248,246,250,244,239,251,241,237,139,127,124,209, - 205,204,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,235,233,233,129, - 116,112,213,193,179,233,210,193,231,212,194,248,243,238,240,230,221, - 240,237,233,241,239,237,238,237,237,234,233,231,228,226,226,235,234, - 232,247,241,235,248,238,232,248,237,233,139,127,123,218,214,212,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,254,254,254,142,129,124,202,177,157,226,199,177,222, - 195,169,243,234,226,250,247,246,248,247,246,239,234,231,236,231,226, - 230,226,222,229,226,222,225,223,221,226,226,226,212,210,208,242,232, - 222,245,231,224,243,230,225,133,120,117,249,249,249,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,206,202, - 200,158,136,124,222,190,165,213,178,146,220,191,164,251,249,247,240, - 230,221,238,225,213,242,230,221,243,234,224,244,235,227,245,237,230, - 245,237,230,216,213,211,206,205,205,240,227,216,236,221,207,246,232, - 224,194,180,172,193,188,185,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,154,141,137,201,167,145,208,169, - 134,211,173,140,227,204,184,237,221,207,239,226,214,242,231,221,243, - 234,225,245,237,230,246,239,232,245,237,229,242,233,223,241,231,220, - 245,236,228,237,222,209,233,215,200,234,216,200,240,225,219,148,136, - 133,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,129,114,110,220,181,158,201,154,113,216,184,155,233,215, - 198,236,220,206,238,225,212,241,228,217,242,231,222,243,234,226,245, - 236,228,245,237,230,245,236,229,241,229,218,236,221,207,233,216,200, - 231,211,192,227,203,182,252,239,235,125,113,109,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,118,104,100, - 227,182,158,205,152,111,226,202,180,233,214,198,235,219,204,237,223, - 209,239,226,214,241,230,219,242,231,222,243,233,224,243,234,224,243, - 234,225,242,231,221,236,219,205,230,210,191,227,203,182,223,196,171, - 252,239,236,118,105,101,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,128,113,109,223,177,154,212,153,114, - 228,207,187,232,214,196,234,217,202,236,222,207,238,224,211,240,227, - 216,240,229,217,242,230,220,241,230,220,241,230,219,240,229,218,237, - 223,210,226,202,180,223,196,172,221,191,166,249,234,230,127,114,110, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,149,135,131,207,164,142,221,161,125,230,202,180,232,213,195, - 234,217,201,235,219,204,237,222,208,238,225,212,239,226,215,240,227, - 216,239,227,215,239,226,214,239,226,214,238,224,210,223,197,173,218, - 188,160,224,195,173,232,214,204,148,135,131,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,196,191,189,170, - 138,124,229,173,143,224,178,149,234,213,196,234,215,199,234,218,202, - 237,221,206,237,223,209,238,223,211,238,224,212,238,224,212,238,224, - 211,236,222,208,236,220,205,219,189,162,214,179,148,236,214,198,185, - 166,155,196,191,189,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,246,245,245,130,115,110,224,175,150,223, - 159,123,230,196,174,234,214,197,234,216,201,236,219,204,236,220,206, - 236,221,207,237,222,209,237,222,208,236,220,206,235,219,204,232,213, - 195,211,175,143,217,182,153,239,220,209,130,116,111,246,245,245,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,199,192,191,154,129,117,231,183,157,222,157,120,226, - 187,161,234,213,196,234,216,200,235,218,203,236,219,205,236,220,206, - 236,219,205,235,218,202,234,217,201,217,186,156,211,173,139,243,224, - 213,163,143,131,199,192,191,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,254,254, - 254,162,149,146,166,137,122,232,185,162,223,162,128,216,161,125,221, - 185,157,226,201,179,231,212,194,234,216,200,230,210,192,225,200,177, - 214,180,149,213,175,144,240,219,207,177,154,142,162,149,146,254,254, - 254,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,252,251,251,161,149, - 146,147,127,118,221,179,158,233,184,158,222,167,134,212,156,116,206, - 152,111,204,153,111,204,157,116,214,174,141,231,202,182,231,207,193, - 155,136,127,161,149,146,252,251,251,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,199,193,192,127,112, - 108,165,139,127,207,169,149,230,192,173,236,202,183,237,204,187,232, - 201,185,212,181,165,170,148,137,128,113,109,199,193,192,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,250,250,249,206,202,200,162,150, - 146,134,119,113,120,106,102,120,106,102,134,119,113,162,150,146,206, - 202,200,250,250,249,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255); - -Const - stdimg_link : Array[0..449] of byte = ( - 66, 77,194, 1, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 11, 0, 0, 0, 11, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 140, 1, 0, 0, 18, 11, 0, 0, 18, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0,128,128,128,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255, 0, 0, 0, 0, 0, 0,128,128,128,255,255,255,255,255,255,255, - 255,255, 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255, 0, 0, 0, 0, 0, 0,128,128,128,255,255,255,255,255, - 255, 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255, 0, 0, 0, 0, 0, 0,128,128,128,255,255,255, - 255,255,255, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0,128,128,128,255, - 255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0, 0,255,255,255, - 0, 0, 0,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0,128,128, - 128,255,255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, - 128,128,128,255,255,255,255,255,255,255,255,255,255,255,255, 0, 0, - 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255, 0, 0, 0, 0, - 0, 0,128,128,128,255,255,255,255,255,255,255,255,255, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255, 0, 0, - 0, 0, 0, 0,128,128,128,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 0, 0, 0, 0, 0, 0,128,128,128,128,128,128,128,128,128,128,128, - 128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128, - 128,128, 0, 0, 0, 0, 0, 0); - -Const - stdimg_menu_exit_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,236,242,246,204, - 219,232,165,193,214,128,167,197, 99,148,184, 22, 94,147, 29, 99,151, - 153,153,153,113,113,113, 84, 84, 84, 81, 81, 81, 79, 79, 79, 76, 76, - 76, 74, 74, 74, 71, 71, 71, 69, 69, 69, 37,103,157, 50,116,168, 61, - 124,175, 71,132,181, 78,138,186, 62,126,173, 32,101,152,255,255,255, - 255,255,255, 88, 88, 88,162,162,162,162,162,162,163,163,163,164,164, - 164,164,164,164,165,165,165, 47,111,165,120,171,210,120,171,211,115, - 167,209,105,160,205, 64,127,174, 35,103,154,255,255,255,255,255,255, - 92, 92, 92,161,161,161, 60,115, 64,160,161,161,163,163,163,163,163, - 163,164,164,164, 54,116,170,125,175,212, 91,154,201, 84,149,199, 88, - 150,200, 65,128,174, 38,105,157,255,255,255,255,255,255, 96, 96, 96, - 160,160,160, 61,118, 65, 54,113, 57,162,162,162,162,162,162,163,163, - 163, 61,121,176,130,179,215, 98,159,204, 90,154,201, 94,155,202, 67, - 129,175, 44,109,160, 55,130, 62, 52,126, 59, 49,121, 55, 46,117, 52, - 73,145, 80, 70,143, 76, 57,115, 61,161,161,161,162,162,162, 69,126, - 180,136,183,217,103,163,207, 97,158,204, 99,159,204, 69,131,177, 49, - 113,164, 59,135, 66,137,203,146,132,200,141,128,198,136,123,195,131, - 119,193,127, 71,143, 77, 59,116, 63,161,161,161, 76,132,186,141,187, - 219,110,168,209,102,166,209, 95,180,223, 71,133,177, 55,117,169, 62, - 139, 70,143,206,153,125,198,135,120,195,129,115,192,124,116,192,124, - 121,194,129, 73,144, 79, 84,127, 87, 84,137,191,148,191,221,117,173, - 212, 99,184,225, 75,212,255, 66,139,184, 61,122,173, 65,144, 74,148, - 210,159,145,208,154,141,205,150,137,203,146,132,200,141, 81,152, 88, - 65,124, 70,159,159,159, 90,142,196,152,195,224,124,179,215,116,175, - 214, 94,196,237, 75,136,179, 69,127,178, 68,148, 77, 66,145, 75, 63, - 141, 72, 61,137, 69, 93,164,101, 90,160, 97, 69,131, 75,158,158,158, - 158,158,158, 96,146,201,158,199,226,131,184,218,125,180,215,126,179, - 215, 79,137,180, 75,132,183,255,255,255,255,255,255,119,119,119,154, - 154,154, 61,138, 69, 73,138, 79,156,156,156,157,157,157,157,157,157, - 102,150,204,162,203,227,137,189,220,131,185,218,132,185,218, 81,139, - 181, 82,137,188,255,255,255,255,255,255,122,122,122,153,153,153, 82, - 145, 89,153,154,153,155,155,155,156,156,156,156,156,156,108,154,208, - 167,206,229,143,193,223,137,189,220,139,189,220, 83,141,182, 90,142, - 194,255,255,255,255,255,255,125,125,125,153,153,153,153,153,153,154, - 154,154,154,154,154,155,155,155,155,155,155,111,157,211,170,209,231, - 171,209,231,152,199,225,145,194,222, 86,143,183, 96,147,198,255,255, - 255,255,255,255,128,128,128,126,126,126,124,124,124,122,122,122,119, - 119,119,117,117,117,114,114,114,113,158,212,111,158,214,135,178,220, - 171,211,232,169,208,230, 88,144,184,103,151,203,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,132,172,220,109,156,212, - 133,177,218, 90,145,185,109,156,207,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,177,202,232, - 108,156,211,112,158,210); - -Const - stdimg_menu_save_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,216,171,142,205,149,112,189,115, 66,183,104, 53,181,104, - 53,180,103, 52,178,102, 52,176,101, 51,174,100, 51,172, 99, 50,170, - 98, 50,169, 97, 50,168, 96, 49,167, 97, 50,171,105, 60,188,134, 97, - 195,125, 79,235,198,173,234,197,173,254,251,248,254,251,248,254,251, - 248,254,251,248,254,251,248,254,251,248,254,251,248,254,251,248,254, - 251,248,254,251,248,200,154,124,199,152,121,173,107, 64,186,108, 56, - 237,202,179,224,162,122,254,250,247, 98,192,136, 98,192,136, 98,192, - 136, 98,192,136, 98,192,136, 98,192,136, 98,192,136, 98,192,136,253, - 249,246,202,141,101,201,155,124,167, 97, 50,187,108, 56,238,204,182, - 225,162,122,254,250,247,191,220,194,191,220,194,191,220,194,191,220, - 194,191,220,194,191,220,194,191,220,194,191,220,194,253,249,246,205, - 144,104,204,158,129,168, 97, 50,187,107, 56,239,206,184,225,162,121, - 254,250,247, 98,192,136, 98,192,136, 98,192,136, 98,192,136, 98,192, - 136, 98,192,136, 98,192,136, 98,192,136,253,249,246,207,147,106,206, - 163,132,170, 97, 50,186,106, 54,239,208,187,226,162,122,254,251,248, - 254,251,248,254,251,248,254,251,248,254,251,248,254,251,248,254,251, - 248,254,251,248,254,251,248,254,251,248,211,150,109,210,167,138,171, - 98, 50,187,106, 54,240,210,190,226,163,122,226,163,122,225,163,122, - 226,163,123,225,163,123,224,161,120,222,159,119,221,159,118,220,157, - 116,217,155,114,216,153,113,214,153,112,213,171,142,173, 99, 51,187, - 106, 54,242,213,194,227,163,122,227,163,122,226,163,123,226,163,123, - 226,164,123,225,162,121,224,161,120,222,160,119,222,158,117,220,157, - 116,218,155,115,217,155,115,218,176,149,175,100, 51,187,106, 54,242, - 216,197,227,164,123,227,163,122,227,164,122,226,164,123,226,163,123, - 225,163,123,225,162,121,223,160,119,222,159,118,221,158,116,219,156, - 114,220,157,116,221,181,154,177,101, 52,187,107, 54,244,217,199,230, - 166,125,200,140,100,201,141,101,201,142,103,203,146,108,203,146,109, - 202,144,105,200,140,101,200,140,100,200,140,100,200,140,100,218,156, - 116,225,186,159,179,102, 52,187,108, 55,244,220,201,231,167,125,249, - 236,225,249,236,225,249,237,227,252,244,238,253,250,247,253,247,243, - 250,237,229,247,231,219,247,229,217,246,229,216,222,160,119,228,190, - 164,180,103, 52,189,110, 58,245,221,204,231,168,126,250,240,232,250, - 240,232,201,141,102,250,240,233,253,248,243,254,250,248,252,244,239, - 249,233,223,247,231,219,247,229,217,224,162,120,231,194,169,182,104, - 53,192,116, 66,246,223,208,232,168,126,252,246,241,252,246,241,200, - 140,100,250,241,233,251,244,238,253,250,247,253,249,246,250,240,232, - 248,232,221,247,230,219,225,163,122,239,213,195,183,106, 54,198,130, - 85,246,223,209,233,170,128,254,250,246,253,250,246,200,140,100,251, - 243,238,251,241,234,252,246,242,254,251,248,252,246,241,249,236,226, - 248,231,219,238,208,186,236,208,189,189,116, 67,214,165,133,246,224, - 209,247,224,209,254,251,248,254,251,247,253,249,246,252,245,240,250, - 240,234,251,242,237,253,249,246,253,250,247,251,241,235,248,233,223, - 236,209,190,205,146,106,226,197,177,225,189,166,217,171,141,201,137, - 94,192,117, 67,189,110, 58,187,108, 55,187,107, 54,187,106, 54,187, - 106, 54,188,108, 57,189,110, 59,187,109, 58,191,116, 68,201,141,101, - 231,206,188,255,255,255); - -Const - stdimg_btn_cancel_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255, 63, 61,237, 59, 56,235,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, 33, - 31,227, 30, 28,226,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255, 74, 71,240, 79, 76,242, 64, 62,237, 60, 57,235,255,255, - 255,255,255,255,255,255,255,255,255,255, 39, 37,229, 36, 34,228, 49, - 47,234, 31, 29,226,255,255,255,255,255,255,255,255,255, 84, 81,243, - 88, 86,245, 99, 97,250, 88, 85,246, 65, 63,237, 61, 58,236,255,255, - 255,255,255,255, 48, 45,231, 44, 42,230, 65, 63,241, 76, 74,246, 49, - 47,234, 31, 29,226,255,255,255,255,255,255, 89, 86,245, 91, 88,246, - 101, 98,250,113,112,255, 89, 86,246, 66, 64,238, 62, 59,236, 57, 55, - 235, 53, 50,233, 71, 69,242, 99, 98,255, 74, 72,244, 47, 45,233, 34, - 32,227,255,255,255,255,255,255,255,255,255, 90, 87,245, 91, 89,246, - 102, 99,250,116,113,255, 90, 88,246, 67, 65,238, 62, 60,236, 80, 77, - 244,104,103,255, 80, 78,245, 54, 52,235, 42, 39,229,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255, 91, 88,246, 92, 90,246, - 103,100,250,116,114,255,115,112,255,112,110,255,110,108,255, 87, 85, - 247, 63, 61,238, 50, 48,232,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255, 92, 89,246, 93, 91,247, - 121,118,255, 89, 86,255, 87, 84,255,114,112,255, 72, 70,240, 60, 57, - 235,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255, 97, 94,248, 93, 90,246,125,121,255, - 94, 91,255, 91, 88,255,118,116,255, 70, 67,239, 65, 63,237,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,105,103,251,102, 99,249,112,109,251,128,126,255,126,123,255, - 124,121,255,121,119,255, 94, 92,247, 71, 68,239, 66, 64,238,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,113,110,253,110, - 107,252,119,116,253,134,130,255,118,115,252,100, 98,248, 96, 93,247, - 109,106,250,123,121,255, 96, 93,247, 72, 69,239, 67, 65,238,255,255, - 255,255,255,255,255,255,255,118,115,255,116,113,254,125,122,254,138, - 135,255,124,121,253,108,105,251, 99, 97,249, 95, 92,247, 97, 94,248, - 110,108,250,125,122,255, 97, 95,247, 73, 70,240, 68, 65,238,255,255, - 255,255,255,255,119,116,255,122,119,255,129,126,255,129,126,254,116, - 113,253,108,105,251,255,255,255,255,255,255, 96, 93,247, 98, 95,248, - 111,109,251,126,124,255, 98, 95,248, 74, 71,240, 69, 66,238,255,255, - 255,255,255,255,119,116,255,122,119,255,121,118,254,114,111,253,255, - 255,255,255,255,255,255,255,255,255,255,255, 97, 94,248,100, 97,248, - 106,104,249, 84, 81,243, 79, 77,242,255,255,255,255,255,255,255,255, - 255,255,255,255,119,116,255,119,116,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255, 98, 95,248, 93, 91,247, - 89, 86,245,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255, 99, 96,248,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_folder_up_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 198,167,146,138, 78, 37,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, - 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, - 74, 32,135, 74, 32,135, 74, 32,138, 78, 37,198,169,148,138, 78, 37, - 217,181,149,221,186,154,221,186,154,221,186,154,221,186,154,221,186, - 154,221,186,154,221,186,154,221,186,154,221,186,154,221,186,154,221, - 186,154,221,186,154,217,181,149,138, 79, 37,135, 74, 32,223,192,162, - 213,172,134,213,172,134,213,172,134,213,172,134,213,172,134,213,172, - 134,213,172,134,213,172,134,213,172,134,213,172,134,213,172,134,213, - 172,134,223,192,162,135, 74, 32,135, 74, 32,226,197,170,215,175,138, - 215,175,138,215,175,138,143, 85, 42,143, 85, 42,143, 85, 42,143, 85, - 42,143, 85, 42,143, 85, 42,215,175,138,215,175,138,215,175,138,226, - 197,170,135, 74, 32,135, 74, 32,228,202,177,217,179,143,217,179,143, - 217,179,143,143, 85, 42,217,179,143,217,179,143,217,179,143,217,179, - 143,217,179,143,217,179,143,217,179,143,217,179,143,228,202,177,135, - 74, 32,135, 74, 32,230,205,181,217,179,143,143, 85, 42,205,164,128, - 143, 85, 42,205,164,128,143, 85, 42,217,179,143,217,179,143,217,179, - 143,217,179,143,217,179,143,217,179,143,230,205,181,135, 74, 32,135, - 74, 32,231,207,184,217,179,143,182,133, 95,143, 85, 42,143, 85, 42, - 143, 85, 42,182,133, 95,217,179,143,217,179,143,217,179,143,217,179, - 143,217,179,143,217,179,143,231,207,184,135, 74, 32,135, 74, 32,232, - 210,188,217,179,143,217,179,143,205,164,128,143, 85, 42,205,164,128, - 217,179,143,217,179,143,217,179,143,217,179,143,217,179,143,217,179, - 143,217,179,143,232,210,188,135, 74, 32,136, 76, 34,230,209,188,234, - 212,192,234,212,192,234,212,192,234,212,192,234,212,192,226,197,169, - 217,179,143,217,179,143,217,179,143,217,179,143,217,179,143,217,179, - 143,234,212,192,135, 74, 32,139, 77, 36,136, 76, 34,135, 74, 32,135, - 74, 32,135, 74, 32,135, 74, 32,140, 82, 42,218,190,167,227,200,173, - 217,179,143,217,179,143,217,179,143,217,179,143,217,179,143,235,215, - 196,135, 74, 32,135, 74, 32,204,164,133,188,136, 95,188,136, 94,188, - 136, 94,188,136, 94,175,120, 80,144, 86, 46,220,194,172,236,217,199, - 236,217,199,236,217,199,236,217,199,236,217,199,233,214,196,138, 79, - 37,135, 74, 32,209,176,151,218,186,158,205,161,124,205,161,123,205, - 161,124,218,186,158,190,150,120,135, 74, 32,135, 74, 32,135, 74, 32, - 135, 74, 32,135, 74, 32,135, 74, 32,138, 78, 37,198,168,147,225,210, - 200,144, 89, 49,218,191,169,236,217,200,236,217,200,236,217,200,218, - 191,169,144, 89, 49,225,210,200,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,225,210, - 200,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,225, - 210,200,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_folder_open_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0,215, 13, 0, 0,215, 13, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 252,252,252,233,233,233,232,232,232,234,234,234,234,234,234,234,234, - 234,234,234,234,234,234,234,234,234,234,234,234,234,234,234,234,234, - 234,234,234,234,234,232,232,232,219,219,219,237,237,237,233,227,223, - 165,129,103,139, 82, 41,139, 82, 41,157,108, 74,157,108, 74,157,108, - 74,157,108, 74,157,108, 74,157,108, 74,157,108, 74,157,108, 74,157, - 108, 74,139, 82, 41,145,110, 84,255,255,255,251,249,247,139, 82, 41, - 209,165,123,210,165,124,210,165,124,210,165,124,210,165,124,210,165, - 124,210,165,124,210,165,124,210,165,124,210,165,124,210,165,124,209, - 165,123,139, 82, 41,246,239,233,231,219,211,157,104, 63,208,161,116, - 207,159,114,207,159,114,207,159,114,207,159,114,207,159,114,207,159, - 114,207,159,114,207,159,114,207,159,114,207,159,114,208,161,116,139, - 82, 41,222,196,174,139, 82, 41,196,151,112,208,162,119,207,160,117, - 207,160,117,207,160,117,207,160,117,207,160,117,207,160,117,207,160, - 117,207,160,117,207,160,117,207,160,117,208,162,119,154,100, 60,207, - 171,139,139, 82, 41,206,164,127,210,165,123,209,164,122,209,164,122, - 209,164,122,209,164,122,209,164,122,209,164,122,209,164,122,209,164, - 122,209,164,122,209,164,122,210,166,124,157,103, 62,139, 82, 41,139, - 82, 41,215,180,148,220,186,153,220,186,153,220,186,153,220,185,152, - 216,178,142,212,169,129,211,168,127,211,168,127,211,168,127,211,168, - 127,211,168,127,212,169,129,209,169,133,139, 82, 41,139, 82, 41,139, - 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41, - 210,173,142,218,180,145,217,179,145,217,179,145,217,179,145,217,179, - 145,217,180,145,217,183,152,139, 82, 41,255,255,255,139, 82, 41,127, - 120,111,253,253,253,248,249,249,243,241,240,210,190,176,139, 82, 41, - 139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, - 41,139, 82, 41,139, 82, 41,255,255,255,139, 82, 41,142,136,127,242, - 242,242,241,242,241,241,241,241,239,239,238,239,239,238,239,239,238, - 239,239,238,239,239,238,239,239,238,239,239,238,125,110, 96,139, 82, - 41,255,255,255,255,255,255,139, 82, 41,177,154,132,151,138,124,150, - 137,123,148,136,121,148,137,123,149,142,131,149,141,130,147,139,129, - 145,137,127,143,135,124,141,133,123,169,151,133,139, 82, 41,255,255, - 255,255,255,255,139, 82, 41,218,183,153,212,172,137,212,172,137,213, - 174,140,217,183,154,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41, - 139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,255,255,255,255,255, - 255,157,103, 62,197,159,132,213,181,155,213,181,155,211,179,152,139, - 82, 41,255,255,255,244,239,235,244,239,235,244,239,235,244,239,235, - 244,239,235,244,239,235,247,242,239,255,255,255,255,255,255,247,242, - 239,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,255,255,255,251, - 249,247,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_folder_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 198,167,146,138, 78, 37,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, - 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, - 74, 32,135, 74, 32,135, 74, 32,138, 78, 37,198,169,148,138, 78, 37, - 217,181,149,221,186,154,221,186,154,221,186,154,221,186,154,221,186, - 154,221,186,154,221,186,154,221,186,154,221,186,154,221,186,154,221, - 186,154,221,186,154,217,181,149,138, 79, 37,135, 74, 32,223,192,162, - 213,172,134,213,172,134,213,172,134,213,172,134,213,172,134,213,172, - 134,213,172,134,213,172,134,213,172,134,213,172,134,213,172,134,213, - 172,134,223,192,162,135, 74, 32,135, 74, 32,226,197,170,215,175,138, - 215,175,138,215,175,138,215,175,138,215,175,138,215,175,138,215,175, - 138,215,175,138,215,175,138,215,175,138,215,175,138,215,175,138,226, - 197,170,135, 74, 32,135, 74, 32,228,202,177,217,179,143,217,179,143, - 217,179,143,217,179,143,217,179,143,217,179,143,217,179,143,217,179, - 143,217,179,143,217,179,143,217,179,143,217,179,143,228,202,177,135, - 74, 32,135, 74, 32,230,205,181,217,179,143,217,179,143,217,179,143, - 217,179,143,217,179,143,217,179,143,217,179,143,217,179,143,217,179, - 143,217,179,143,217,179,143,217,179,143,230,205,181,135, 74, 32,135, - 74, 32,231,207,184,217,179,143,217,179,143,217,179,143,217,179,143, - 217,179,143,217,179,143,217,179,143,217,179,143,217,179,143,217,179, - 143,217,179,143,217,179,143,231,207,184,135, 74, 32,135, 74, 32,232, - 210,188,217,179,143,217,179,143,217,179,143,217,179,143,217,179,143, - 217,179,143,217,179,143,217,179,143,217,179,143,217,179,143,217,179, - 143,217,179,143,232,210,188,135, 74, 32,136, 76, 34,230,209,188,234, - 212,192,234,212,192,234,212,192,234,212,192,234,212,192,226,197,169, - 217,179,143,217,179,143,217,179,143,217,179,143,217,179,143,217,179, - 143,234,212,192,135, 74, 32,139, 77, 36,136, 76, 34,135, 74, 32,135, - 74, 32,135, 74, 32,135, 74, 32,140, 82, 42,218,190,167,227,200,173, - 217,179,143,217,179,143,217,179,143,217,179,143,217,179,143,235,215, - 196,135, 74, 32,135, 74, 32,204,164,133,188,136, 95,188,136, 94,188, - 136, 94,188,136, 94,175,120, 80,144, 86, 46,220,194,172,236,217,199, - 236,217,199,236,217,199,236,217,199,236,217,199,233,214,196,138, 79, - 37,135, 74, 32,209,176,151,218,186,158,205,161,124,205,161,123,205, - 161,124,218,186,158,190,150,120,135, 74, 32,135, 74, 32,135, 74, 32, - 135, 74, 32,135, 74, 32,135, 74, 32,138, 78, 37,198,168,147,225,210, - 200,144, 89, 49,218,191,169,236,217,200,236,217,200,236,217,200,218, - 191,169,144, 89, 49,225,210,200,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,225,210, - 200,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,225, - 210,200,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_btn_close_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,183,183,183,174,174,174, 48,113,169, 44,110,166, 40,107, - 163, 36,104,160, 33,102,158, 29, 99,155, 26, 97,153, 23, 95,151, 20, - 92,148, 17, 91,147,108,108,108,108,108,108,255,255,255,255,255,255, - 255,255,255,255,255,255, 54,117,173,134,182,216,131,179,215,129,178, - 214,125,175,213,123,173,212,121,171,211,118,170,210,116,168,209, 21, - 93,149,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255, 60,121,177,139,185,218,102,162,206, 98,160,205, 95,157, - 203, 91,154,201, 88,151,200, 84,149,199,119,171,211, 25, 96,152,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 66,125,181,143,189,220,108,167,208,103,164,207,100,161,205, 96,158, - 204, 92,155,202, 89,153,201,123,173,212, 30,100,156,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255, 72,130,186, - 147,192,221,113,171,210,109,168,209,105,165,207,102,162,206, 98,159, - 204, 94,156,203,127,176,213, 35,103,159,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255, 78,134,190,152,195,223, - 119,175,213,115,172,211,111,169,210,107,167,208, 91,183,227, 84,194, - 237,129,180,215, 40,107,163,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255, 83,138,194,156,198,225,124,179,215, - 121,177,213,117,173,212,113,171,210, 95,186,228, 75,212,255,124,187, - 224, 46,111,167,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255, 89,142,198,160,201,227,130,184,217,126,181,216, - 122,178,214,119,175,213,115,172,211,109,171,212,140,186,218, 51,115, - 171,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255, 94,145,201,164,204,228,135,187,219,132,185,218,128,182,216, - 124,179,215,121,176,213,116,173,212,143,189,220, 57,119,175,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, 99, - 149,205,168,207,229,140,191,221,136,189,220,133,186,219,129,183,217, - 126,180,215,122,178,214,148,193,221, 63,124,180,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,103,152,208,171, - 209,231,144,194,223,141,192,222,138,190,220,135,187,219,131,184,218, - 128,182,216,153,196,224, 69,128,184,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,107,155,211,174,212,232,171, - 211,232,170,209,231,168,207,229,165,205,228,162,203,228,160,201,226, - 157,199,225, 75,132,188,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,110,157,213,108,155,211,105,154,210,102, - 151,207, 99,149,205, 96,147,203, 92,144,200, 89,142,198, 85,139,195, - 81,136,192,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_edit_copy_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,180,183, - 181,134,139,137,133,138,136,133,138,136,133,138,136,133,138,136,133, - 138,136,133,138,136,164,167,166,194,197,196,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,136,141,139,244,244, - 244,246,247,247,245,246,246,251,252,252,251,251,251,212,212,212,150, - 154,152,226,228,227,133,138,136,194,197,196,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,136,141,139,249,250,250,239,240, - 240,239,240,240,239,240,240,250,250,250,250,250,250,149,154,152,250, - 250,250,226,227,227,133,138,136,157,161,160,219,220,220,195,197,196, - 195,197,196,195,197,196,135,140,138,253,254,254,239,240,240,239,240, - 240,239,240,240,239,240,240,250,250,250,149,154,152,250,250,250,247, - 248,248,226,228,227,133,138,136,196,198,197,249,249,249,249,250,250, - 249,249,249,136,141,139,255,255,255,239,240,240,239,240,240,239,240, - 240,239,240,240,239,240,240,137,142,140,137,142,140,137,142,140,137, - 142,140,133,138,136,196,198,197,252,252,252,245,245,245,245,245,245, - 136,141,139,255,255,255,239,240,240,198,199,199,198,199,199,198,199, - 199,198,199,199,198,199,199,238,238,238,246,247,247,195,196,195,133, - 138,136,196,198,197,255,255,255,246,246,246,225,226,226,135,140,138, - 255,255,255,239,240,240,239,240,240,239,240,240,239,240,240,239,240, - 240,239,240,240,239,240,240,250,250,250,243,243,243,133,138,136,196, - 198,197,255,255,255,246,247,247,246,246,246,136,141,139,255,255,255, - 239,240,240,198,199,199,198,199,199,198,199,199,198,199,199,198,199, - 199,239,240,240,239,240,240,255,255,255,133,138,136,196,198,197,255, - 255,255,247,247,247,226,227,227,135,140,138,255,255,255,239,240,240, - 239,240,240,239,240,240,239,240,240,239,240,240,239,240,240,239,240, - 240,239,240,240,255,255,255,133,138,136,196,198,197,255,255,255,247, - 248,248,247,247,247,136,141,139,255,255,255,239,240,240,198,199,199, - 198,199,199,198,199,199,198,199,199,198,199,199,198,199,199,239,240, - 240,255,255,255,133,138,136,196,198,197,255,255,255,247,248,248,227, - 228,228,135,140,138,255,255,255,239,240,240,239,240,240,239,240,240, - 239,240,240,239,240,240,239,240,240,239,240,240,239,240,240,255,255, - 255,133,138,136,196,198,197,255,255,255,247,248,248,247,248,248,136, - 141,139,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,133,138, - 136,196,198,197,255,255,255,247,248,248,227,228,228,170,173,173,133, - 138,136,133,138,136,133,138,136,133,138,136,133,138,136,133,138,136, - 133,138,136,133,138,136,133,138,136,133,138,136,177,180,179,196,198, - 197,255,255,255,247,248,248,247,247,247,247,247,247,247,247,247,247, - 247,247,247,247,247,247,248,248,247,248,248,255,255,255,194,197,196, - 255,255,255,255,255,255,255,255,255,255,255,255,196,198,197,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,194,197,196,255,255,255, - 255,255,255,255,255,255,255,255,255,219,220,220,194,197,196,194,197, - 196,194,197,196,194,197,196,194,197,196,194,197,196,194,197,196,194, - 197,196,194,197,196,194,197,196,217,219,218,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_edit_delete_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,186,188,188,145,148,147,173,176,175,255,255, - 255,255,255,255,144,148,146,158,161,160,163,166,164,255,255,255,255, - 255,255,219,220,219,151,153,153,189,191,190,255,255,255,255,255,255, - 255,255,255,141,145,144,250,250,250,151,154,153,169,172,171,159,162, - 161,150,154,152,238,239,239,170,174,172,155,158,157,152,155,154,139, - 142,141,255,255,255,172,175,175,255,255,255,255,255,255,255,255,255, - 186,188,188,142,146,145,246,246,246,153,156,155,171,173,172,143,147, - 144,224,225,224,178,180,180,211,213,212,152,155,154,236,236,236,160, - 163,162,212,213,213,255,255,255,255,255,255,255,255,255,255,255,255, - 141,144,143,221,222,221,142,147,144,201,201,201,138,143,140,206,208, - 207,164,166,165,200,200,200,124,128,127,227,228,228,146,149,148,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,117,121,120, - 203,205,204,133,138,135,166,167,166,146,147,147,179,180,179,146,147, - 146,182,183,182,124,128,127,189,190,189,123,126,125,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,106,110,109,205,206,206, - 108,111,111,172,174,173,109,112,111,175,177,176,108,111,110,178,180, - 179,111,115,114,179,180,180,109,113,112,255,255,255,255,255,255,255, - 255,255,165,118, 87,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32, - 135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, - 32,135, 74, 32,135, 74, 32,135, 74, 32,135, 74, 32,165,118, 87,135, - 74, 32,221,187,156,207,159,114,207,159,114,207,159,114,207,159,114, - 207,159,114,207,159,114,207,159,114,207,159,114,207,159,114,207,159, - 114,207,159,114,207,159,114,221,187,156,135, 74, 32,135, 74, 32,221, - 187,156,221,187,156,221,187,156,221,187,156,221,187,156,221,187,156, - 221,187,156,221,187,156,221,187,156,221,187,156,221,187,156,221,187, - 156,221,187,156,221,187,156,135, 74, 32,135, 74, 32,221,187,156,202, - 138, 88,202,138, 88,202,138, 88,202,138, 88,202,138, 88,202,138, 88, - 202,138, 88,202,138, 88,202,138, 88,202,138, 88,202,138, 88,202,138, - 88,221,187,156,135, 74, 32,135, 74, 32,221,187,156,134, 82, 44,134, - 81, 43,134, 81, 43,134, 81, 43,134, 81, 43,134, 81, 43,134, 82, 44, - 134, 82, 44,134, 82, 44,134, 82, 44,134, 82, 44,134, 82, 44,221,187, - 156,135, 74, 32,135, 74, 32,221,187,156,106, 91, 78,201,201,201,156, - 156,156,156,156,156,156,156,156,155,155,155,155,155,155,155,155,155, - 155,155,155,155,155,155,155,155,155,106, 91, 78,221,187,156,135, 74, - 32,135, 74, 32,221,187,156,119,124,122,217,217,217,189,189,189,189, - 189,189,189,189,189,189,189,189,188,188,188,188,188,188,188,188,188, - 191,191,191,192,192,192,119,124,122,221,187,156,135, 74, 32,195,165, - 144,135, 74, 32,133,138,136,231,231,231,215,215,215,214,214,214,214, - 214,214,214,214,214,214,214,214,213,213,213,213,213,213,218,218,218, - 220,220,220,133,138,136,135, 74, 32,195,165,144,255,255,255,255,255, - 255,133,138,136,241,241,241,235,235,235,235,235,235,235,235,235,234, - 234,234,234,234,234,234,234,234,234,234,234,234,234,234,233,233,233, - 133,138,136,255,255,255,255,255,255,255,255,255,255,255,255,171,174, - 173,133,138,136,133,138,136,133,138,136,133,138,136,133,138,136,133, - 138,136,133,138,136,133,138,136,133,138,136,133,138,136,171,174,173, - 255,255,255,255,255,255); - -Const - stdimg_search_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,252, - 253,254,231,238,244,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,250,251,253,100,148,186, 34, - 103,157,129,168,198,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,250,252,253,111,156,194, 85,141,188,137,181,221, 24, - 95,151,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,251,252, - 253,123,164,202,100,151,197,157,193,228,102,153,199, 49,113,165,255, - 255,255,255,255,255,255,255,255,255,255,255,255,254,254,233,207,186, - 219,178,146,211,166,128,208,161,124,210,166,133,174,161,153,117,162, - 204,171,203,232,118,164,206, 64,123,175,222,232,241,255,255,255,255, - 255,255,255,255,255,255,254,254,232,202,176,232,201,174,245,225,205, - 247,229,211,247,229,209,243,221,200,223,186,156,199,168,145,134,174, - 213, 80,135,187,225,234,243,255,255,255,255,255,255,255,255,255,255, - 255,255,241,219,200,237,208,183,248,232,217,245,222,200,243,216,189, - 243,214,187,244,219,194,247,228,210,223,187,157,160,151,149,227,236, - 245,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,238, - 206,178,247,231,215,246,225,204,244,219,194,244,218,192,243,216,189, - 243,215,187,244,219,194,243,222,201,210,168,135,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,240,206,175,249, - 236,223,245,223,200,245,221,198,244,220,195,244,218,193,243,217,190, - 243,215,189,248,230,211,211,166,128,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,244,211,181,249,237,225,246, - 225,204,245,223,201,245,222,199,244,220,196,244,219,194,244,218,192, - 248,231,214,215,171,135,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,248,219,193,249,235,222,247,231,214,246, - 225,204,245,224,202,245,222,200,245,221,197,246,225,203,245,226,208, - 223,185,153,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,252,234,216,248,226,204,250,238,227,247,231,214,246, - 226,206,246,225,203,246,227,208,249,234,221,236,207,181,236,212,191, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,251,228,206,249,226,205,250,236,222,249,238,226,249, - 237,226,248,233,218,240,213,189,237,208,183,255,254,254,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,252,234,217,250,221,194,246,214,185,244,211,181,243, - 212,184,245,224,205,255,255,254,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_dialog_warning_32 : Array[0..3125] of byte = ( - 66, 77, 54, 12, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 32, 0, 0, 0, 32, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 12, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,252,252,252,244,244,244,237,237,237,235,235, - 235,235,235,235,235,235,235,235,235,235,235,235,235,235,235,235,235, - 235,235,235,235,235,235,235,235,235,235,235,235,235,235,235,235,235, - 235,235,235,235,235,235,235,235,235,235,235,235,235,235,235,235,235, - 235,235,235,235,237,237,237,242,242,242,248,248,248,254,254,254,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,239,239,239, - 222,222,222,198,198,207,190,190,201,186,186,197,186,186,197,186,186, - 197,186,186,197,186,186,197,186,186,197,186,186,197,186,186,197,186, - 186,197,186,186,197,186,186,197,186,186,197,186,186,197,186,186,197, - 186,186,197,186,186,197,186,186,197,186,186,197,186,186,197,190,190, - 201,189,189,200,197,197,206,223,223,223,246,246,246,255,255,255,255, - 255,255,255,255,255,244,244,244,178,178,210, 22, 22,165, 0, 0,159, - 0, 0,159, 0, 0,159, 0, 0,159, 0, 0,159, 0, 0,159, 0, 0, - 159, 0, 0,159, 0, 0,159, 0, 0,159, 0, 0,159, 0, 0,159, 0, - 0,159, 0, 0,159, 0, 0,159, 0, 0,159, 0, 0,159, 0, 0,159, - 0, 0,159, 0, 0,159, 0, 0,159, 0, 0,159, 0, 0,159, 0, 0, - 159, 21, 21,165,173,173,209,250,250,250,255,255,255,255,255,255,243, - 243,243, 39, 39,171, 61, 61,196,112,112,224,117,117,226,116,116,226, - 113,113,225,111,111,225,108,108,224,105,105,223,102,102,223,100,100, - 222, 97, 97,222, 94, 94,221, 92, 92,220, 89, 89,220, 86, 86,219, 83, - 83,219, 81, 81,218, 78, 78,218, 75, 75,217, 72, 72,216, 69, 69,216, - 67, 67,215, 64, 64,215, 62, 62,214, 54, 54,212, 28, 28,188, 20, 20, - 166,246,246,246,255,255,255,255,255,255,253,253,253, 15, 15,166,121, - 121,221, 20, 20,208, 0, 0,204, 0, 0,204, 0, 0,204, 0, 0,204, - 0, 0,204, 0, 0,204, 0, 0,204, 0, 0,204, 0, 0,204, 0, 0, - 204, 0, 0,204, 0, 0,204, 0, 0,204, 0, 0,204, 0, 0,204, 0, - 0,204, 0, 0,204, 0, 0,204, 0, 0,204, 0, 0,204, 0, 0,204, - 0, 0,204, 10, 10,206, 56, 56,207, 2, 2,160,247,247,251,255,255, - 255,255,255,255,255,255,255, 90, 90,194, 89, 89,200, 58, 58,216, 0, - 0,204,163,163,219,210,210,224,210,210,224,211,211,225,212,212,226, - 212,212,226,213,213,227,214,214,228,215,215,229,216,216,230,216,216, - 230,217,217,231,217,217,231,218,218,232,218,218,232,219,219,233,220, - 220,234,221,221,235,222,222,236,193,193,231, 0, 0,204, 27, 27,209, - 44, 44,192, 53, 53,181,255,255,255,255,255,255,255,255,255,255,255, - 255,221,221,242, 25, 25,168,117,117,221, 8, 8,206, 80, 80,211,224, - 224,224,225,225,225,225,225,225,226,226,226,227,227,227,227,227,227, - 228,228,228,229,229,229,230,230,230,230,230,230,231,231,231,232,232, - 232,233,233,233,234,234,234,234,234,234,235,235,235,236,236,236,237, - 237,237,105,105,219, 3, 3,205, 59, 59,211, 14, 14,166,193,193,232, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,109,109, - 201, 85, 85,197, 68, 68,218, 2, 2,204,179,179,219,224,224,224,225, - 225,225,225,225,225,226,226,226,227,227,227,227,227,227,228,228,228, - 60, 60, 60, 55, 55, 55,230,230,230,231,231,231,232,232,232,233,233, - 233,234,234,234,234,234,234,235,235,235,205,205,231, 7, 7,205, 36, - 36,211, 47, 47,188, 70, 70,186,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,234,234,247, 23, 23,169,121,121, - 220, 14, 14,207, 59, 59,209,223,223,223,224,224,224,224,224,224,225, - 225,225,226,226,226,226,226,226,227,227,227, 55, 55, 55, 53, 53, 53, - 230,230,230,230,230,230,231,231,231,232,232,232,233,233,233,234,234, - 234,234,234,234, 82, 82,215, 8, 8,206, 67, 67,210, 10, 10,163,212, - 212,239,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,129,129,208, 74, 74,190, 81, 81,220, 0, 0, - 204,162,162,218,223,223,223,224,224,224,224,224,224,225,225,225,226, - 226,226,226,226,226,215,215,215,215,215,215,229,229,229,230,230,230, - 230,230,230,231,231,231,232,232,232,233,233,233,186,186,227, 1, 1, - 204, 47, 47,213, 46, 46,185, 96, 96,196,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 244,244,251, 25, 25,169,121,121,218, 23, 23,209, 42, 42,208,221,221, - 223,223,223,223,224,224,224,224,224,224,225,225,225,226,226,226, 37, - 37, 37, 37, 37, 37,228,228,228,229,229,229,229,229,229,230,230,230, - 231,231,231,232,232,232, 59, 59,211, 14, 14,207, 73, 73,209, 11, 11, - 164,228,228,245,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,151,151,216, - 63, 63,185, 94, 94,222, 0, 0,204,141,141,215,223,223,223,223,223, - 223,224,224,224,224,224,224,225,225,225, 27, 27, 27, 27, 27, 27,227, - 227,227,228,228,228,229,229,229,229,229,229,230,230,230,164,164,223, - 0, 0,204, 60, 60,215, 41, 41,179,120,120,205,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,251,251,253, 35, 35,174,116,116,215, - 34, 34,211, 27, 27,206,215,215,221,223,223,223,223,223,223,224,224, - 224,224,224,224, 13, 13, 13, 13, 13, 13,226,226,226,227,227,227,228, - 228,228,229,229,229,226,226,228, 40, 40,209, 24, 24,209, 75, 75,206, - 16, 16,167,241,241,250,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,172,172,224, 49, 49,178,106,106,223, 1, 1,204, - 121,121,213,222,222,222,222,222,222,223,223,223,224,224,224, 3, 3, - 3, 3, 3, 3,225,225,225,226,226,226,227,227,227,228,228,228,140, - 140,218, 1, 1,204, 75, 75,218, 34, 34,174,144,144,213,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,254, - 254,255, 49, 49,179,109,109,211, 47, 47,213, 16, 16,206,206,206,220, - 222,222,222,222,222,222,215,215,215, 0, 0, 0, 0, 0, 0,217,217, - 217,225,225,225,226,226,226,218,218,226, 25, 25,207, 36, 36,211, 74, - 74,203, 27, 27,171,249,249,253,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,193,193,232, 36, - 36,173,117,117,224, 4, 4,205,102,102,212,221,221,221,222,222,222, - 204,204,204, 0, 0, 0, 0, 0, 0,206,206,206,225,225,225,225,225, - 225,118,118,216, 4, 4,205, 87, 87,219, 27, 27,170,167,167,222,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255, 69, 69,186,100,100,205, 59, - 59,216, 7, 7,205,195,195,219,221,221,221,193,193,193, 0, 0, 0, - 0, 0, 0,195,195,195,224,224,224,206,206,223, 12, 12,205, 49, 49, - 214, 70, 70,199, 45, 45,178,254,254,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,211,211,238, 25, 25,170,124,124,224, 8, 8,206, 82, - 82,210,221,221,221,218,218,218,207,207,207,207,207,207,220,220,220, - 223,223,223, 97, 97,213, 9, 9,206, 98, 98,219, 17, 17,166,189,189, - 230,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255, 92, 92,194, 89, 89,199, 72, 72,218, 2, 2,204,180,180,217,221, - 221,221,221,221,221,222,222,222,222,222,222,192,192,220, 4, 4,204, - 64, 64,217, 65, 65,194, 68, 68,186,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,226,226,244, 20, 20, - 168,128,128,224, 15, 15,207, 63, 63,209,220,220,220,221,221,221,221, - 221,221,222,222,222, 74, 74,210, 17, 17,207,104,104,219, 11, 11,163, - 210,210,238,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,114,114,202, 79, 79,193, 85, 85, - 220, 0, 0,204,162,162,215,220,220,220,220,220,220,173,173,217, 1, - 1,204, 80, 80,220, 59, 59,189, 92, 92,194,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,238,238,249, 20, 20,167,128,128,222, 25, 25,209, 44, 44, - 207,218,218,219,220,220,220, 53, 53,208, 28, 28,210,106,106,217, 10, - 10,164,226,226,244,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 137,137,211, 67, 67,187, 99, 99,223, 0, 0,204,143,143,214,152,152, - 214, 1, 1,204, 97, 97,223, 51, 51,184,118,118,204,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,246,246,252, 25, 25,169, - 122,122,218, 36, 36,211, 21, 21,206, 23, 23,205, 42, 42,212,104,104, - 215, 14, 14,165,239,239,249,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,158,158,218, 53, 53,181,113,113,225, - 1, 1,204, 3, 3,205,113,113,225, 41, 41,177,142,142,212,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,252,252,254, 37, 37,174,111,111,213, 66, 66,217, 70, 70,218, - 96, 96,210, 25, 25,170,248,248,252,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,180, - 180,227, 22, 22,168,109,109,218,106,106,218, 20, 20,169,165,165,221, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,140,140,211, 12, - 12,165, 8, 8,163,124,124,206,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,252,252,254,251,251,253,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255); - -Const - stdimg_hidden : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 15, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 18, 11, 0, 0, 18, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255, 0, 0, 0, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255, 0, 0, 0,255,255,255, - 255,255,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255, 0, 0, 0,255,255,255,255,255,255, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255, 0, 0, 0,255,255,255,255,255,255, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255, 0, 0, 0,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, 0, - 0, 0,255,255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255, 0, 0, 0,255, - 255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255, 0, 0, 0,255,255,255,255, - 255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255, 0, 0, 0,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255, 0, 0, 0,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255, 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255, 0, 0, - 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 255,255,255,255,255,255,255,255,255,255,255,255, 0, 0, 0,255,255, - 255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255, 0, 0, 0,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, 0, - 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255, 0, 0, 0,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255, 0, 0, 0); - -Const - stdimg_document : Array[0..1061] of byte = ( - 66, 77, 38, 4, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 18, 0, 0, 0, 18, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 240, 3, 0, 0,235, 10, 0, 0,235, 10, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,135,135,135,135,135,135,135,135,135,135,135,135, 98, 98, - 98, 91, 91, 91, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, - 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 97, 97, 97, - 135,135,135,135,135,135, 0, 0,135,135,135,135,135,135,135,135,135, - 88, 88, 88, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, - 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, - 48, 48, 90, 90, 90,135,135,135,135,135,135, 0, 0,135,135,135,135, - 135,135,135,135,135, 88, 88, 88,182,193,198,182,193,198,172,189,196, - 163,184,195,154,179,194,145,175,192,136,170,191,127,165,190,118,160, - 189,115,158,188, 48, 48, 48, 90, 90, 90,135,135,135,135,135,135, 0, - 0,135,135,135,135,135,135,135,135,135, 88, 88, 88,222,222,222,225, - 237,244,216,232,242,208,228,240,200,222,238,191,218,236,184,214,233, - 176,209,231,167,204,229,120,161,188, 48, 48, 48, 90, 90, 90,135,135, - 135,135,135,135, 0, 0,135,135,135,135,135,135,135,135,135, 88, 88, - 88,222,222,222,233,241,247,137,144,148,132,141,147,127,139,146,122, - 136,145,117,133,143,112,130,142,176,209,231,127,163,188, 48, 48, 48, - 90, 90, 90,135,135,135,135,135,135, 0, 0,135,135,135,135,135,135, - 135,135,135, 88, 88, 88,222,222,222,242,246,250,234,242,248,226,238, - 245,218,233,242,210,228,240,201,224,238,193,220,236,186,214,233,133, - 166,188, 48, 48, 48, 90, 90, 90,135,135,135,135,135,135, 0, 0,135, - 135,135,135,135,135,135,135,135, 88, 88, 88,222,222,222,251,252,252, - 148,151,152,143,148,151,138,145,149,133,142,148,128,139,146,123,136, - 145,194,219,236,138,168,188, 48, 48, 48, 90, 90, 90,135,135,135,135, - 135,135, 0, 0,135,135,135,135,135,135,135,135,135, 88, 88, 88,222, - 222,222,255,255,255,252,253,253,244,248,250,235,243,248,228,238,245, - 220,234,243,212,230,241,202,223,236,144,171,188, 48, 48, 48, 90, 90, - 90,135,135,135,135,135,135, 0, 0,135,135,135,135,135,135,135,135, - 135, 88, 88, 88,222,222,222,255,255,255,155,155,155,154,154,154,148, - 151,152,143,148,151,139,145,149,134,143,148,212,226,236,151,174,188, - 48, 48, 48, 90, 90, 90,135,135,135,135,135,135, 0, 0,135,135,135, - 135,135,135,135,135,135, 88, 88, 88,223,223,223,255,255,255,255,255, - 255,255,255,255,254,254,254,245,248,251,237,244,248,227,237,243,220, - 231,238,151,174,188, 48, 48, 48, 90, 90, 90,135,135,135,135,135,135, - 0, 0,135,135,135,135,135,135,135,135,135, 88, 88, 88,222,222,222, - 255,255,255,155,155,155,155,155,155,155,155,155,155,155,155,246,249, - 251,236,240,244,217,224,231,175,182,190, 48, 48, 48, 90, 90, 90,135, - 135,135,135,135,135, 0, 0,135,135,135,135,135,135,135,135,135, 88, - 88, 88,222,222,222,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,245,245,246,222,224,226,177,183,188,132,137,143, 48, 48, - 48, 90, 90, 90,135,135,135,135,135,135, 0, 0,135,135,135,135,135, - 135,135,135,135, 88, 88, 88,222,222,222,255,255,255,155,155,155,155, - 155,155,155,155,155,255,255,255,137,137,137,112,112,112,107,107,107, - 66, 66, 66, 48, 48, 48, 96, 96, 96,135,135,135,135,135,135, 0, 0, - 135,135,135,135,135,135,135,135,135, 88, 88, 88,222,222,222,255,255, - 255,255,255,255,255,255,255,255,255,255,252,252,252,112,112,112,206, - 206,206,255,255,255,153,153,153, 48, 48, 48,135,135,135,133,133,133, - 135,135,135, 0, 0,135,135,135,135,135,135,135,135,135, 88, 88, 88, - 222,222,222,255,255,255,255,255,255,255,255,255,255,255,255,234,234, - 234,109,109,109,255,255,255,153,153,153, 88, 88, 88,135,135,135,133, - 133,133,135,135,135,135,135,135, 0, 0,135,135,135,135,135,135,135, - 135,135, 88, 88, 88,222,222,222,222,222,222,222,222,222,222,222,222, - 222,222,222,177,183,188, 88, 88, 88,153,153,153, 88, 88, 88,135,135, - 135,133,133,133,135,135,135,135,135,135,135,135,135, 0, 0,135,135, - 135,135,135,135,135,135,135, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, - 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, - 135,135,135,133,133,133,135,135,135,135,135,135,135,135,135,135,135, - 135, 0, 0,135,135,135,135,135,135,135,135,135,135,135,135,135,135, - 135,135,135,135,135,135,135,135,135,135,135,135,135,135,135,135,135, - 135,135,135,135,135,135,135,135,135,135,135,135,135,135,135,135,135, - 135,135,135,135,135,135, 0, 0); - -Const - stdimg_menu_preferences_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,215,194,180,135, 74, 32,135, 74, 32,135, 74, 32,223,207, - 196,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 135, 74, 32,190,165,146,184,156,134,184,156,134,135, 74, 32,223,207, - 196,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,193, - 196,195,154,158,157,193,196,195,255,255,255,255,255,255,135, 74, 32, - 204,187,173,167,145,125,181,149,122,174,139,114,135, 74, 32,223,207, - 196,255,255,255,255,255,255,255,255,255,219,220,220,133,138,136,158, - 161,160,133,138,136,255,255,255,255,255,255,135, 74, 32,204,187,173, - 164,141,120,162,138,116,180,149,122,179,147,124,135, 74, 32,255,255, - 255,255,255,255,219,220,220,133,138,136,210,211,212,194,195,196,133, - 138,136,255,255,255,255,255,255,232,221,213,135, 74, 32,212,200,189, - 164,141,120,164,141,120,190,165,146,135, 74, 32,255,255,255,219,220, - 220,133,138,136,226,227,228,194,196,198,133,138,136,193,196,195,255, - 255,255,255,255,255,255,255,255,243,237,233,135, 74, 32,204,187,173, - 204,187,173,179,147,124,135, 74, 32,193,196,195,133,138,136,211,211, - 212,189,190,191,133,138,136,219,220,220,253,253,253,255,255,255,255, - 255,255,255,255,255,255,255,255,243,237,233,135, 74, 32,135, 74, 32, - 135, 74, 32,133,131,125,170,173,173,200,201,202,189,190,191,133,138, - 136,219,220,220,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 181,183,184,133,138,136,183,184,185,133,138,136,219,220,220,253,253, - 253,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,219, - 220,220,133,138,136,133,138,136,133,138,136,133,138,136,208,209,210, - 163,164,164,133,138,136,193,196,195,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,219,220,220,133,138,136,243, - 243,243,239,240,240,237,238,238,234,236,236,182,185,186,133,138,136, - 219,220,220,133,138,136,219,220,220,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,133,138,136,245,246,246,169,172,171,133, - 138,136,247,247,247,226,227,229,170,173,173,245,246,246,255,255,255, - 219,220,220,133,138,136,219,220,220,255,255,255,255,255,255,255,255, - 255,255,255,255,219,220,220,133,138,136,255,255,255,219,220,220,133, - 138,136,250,250,250,133,138,136,255,255,255,255,255,255,255,255,255, - 219,220,220,133,138,136,135,140,138,179,179,179,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,133,138,136,238, - 240,240,133,138,136,255,255,255,255,255,255,255,255,255,255,255,255, - 133,138,136,240,240,240,133,138,136,179,179,179,255,255,255,255,255, - 255,255,255,255,255,255,255,133,138,136,233,235,236,133,138,136,219, - 220,220,255,255,255,255,255,255,255,255,255,255,255,255,179,179,179, - 133,138,136,238,239,239,133,138,136,255,255,255,255,255,255,255,255, - 255,255,255,255,219,220,220,133,138,136,219,220,220,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,179,179,179, - 133,138,136,219,220,220,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255); - -Const - stdimg_choice_no_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,217,217,217, 98, 98,162,164,164,178,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,152,152,171,101,101,160,227,227,227,255,255,255, - 214,214,216, 48, 48,162, 55, 55,241, 19, 19,202,152,152,172,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,254,254,254,135, - 135,164, 17, 17,205, 48, 48,234, 61, 61,154,226,226,226,102,102,162, - 8, 8,224, 72, 72,245, 76, 76,240, 5, 5,200,135,135,163,255,255, - 255,255,255,255,255,255,255,249,249,249,116,116,157, 5, 5,205, 90, - 90,239, 90, 90,244, 9, 9,217,126,126,165, 85, 85,174, 34, 34,254, - 55, 55,255, 89, 89,255, 74, 74,237, 5, 5,199,119,119,156,253,253, - 253,244,244,244, 98, 98,152, 8, 8,206, 90, 90,237,115,115,255, 85, - 85,255, 54, 54,253,110,110,169,151,151,196, 29, 29,255, 43, 43,255, - 57, 57,255, 86, 86,255, 69, 69,235, 5, 5,196,102,102,148, 85, 85, - 147, 9, 9,203, 84, 84,237,106,106,255, 80, 80,255, 65, 65,255, 52, - 52,255,175,175,199,255,255,255,147,147,196, 30, 30,255, 43, 43,255, - 53, 53,255, 74, 74,255, 55, 55,232, 1, 1,187, 6, 6,192, 68, 68, - 237, 88, 88,255, 71, 71,255, 62, 62,255, 54, 54,249,171,171,200,255, - 255,255,255,255,255,255,255,255,163,163,199, 31, 31,251, 47, 47,255, - 60, 60,255, 78, 78,255, 49, 49,232, 55, 55,237, 75, 75,255, 56, 56, - 255, 50, 50,255, 55, 55,241,188,188,206,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,184,184,206, 77, 77,238, 97, 97,255, - 96, 96,255, 96, 96,255, 98, 98,255, 98, 98,255, 91, 91,255, 73, 73, - 227,207,207,217,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,226,226,226, 43, 43,156, 61, 61,244, 99, 99,255, - 99, 99,255,100,100,255,100,100,255, 54, 54,237, 75, 75,146,247,247, - 247,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,214, - 214,214, 47, 47,123, 0, 0,166, 49, 49,242,107,107,255,106,106,255, - 106,106,255,105,105,255, 33, 33,230, 0, 0,152, 82, 82,127,240,240, - 240,255,255,255,255,255,255,255,255,255,212,212,213, 43, 43,115, 0, - 0,164, 55, 55,243,121,121,255,120,120,255,121,121,255,121,121,255, - 120,120,255,116,116,255, 38, 38,229, 0, 0,146, 82, 82,123,239,239, - 239,255,255,255,228,228,228, 45, 45,112, 0, 0,156, 66, 66,242,138, - 138,255,137,137,255,136,136,255,102,102,209,103,103,224,141,141,255, - 136,136,255,132,132,255, 42, 42,227, 0, 0,139, 91, 91,128,250,250, - 250,182,182,189, 0, 0,156, 73, 73,242,155,155,255,153,153,255,153, - 153,255,115,115,207,249,249,249,222,222,227,110,110,228,158,158,255, - 153,153,255,148,148,255, 47, 47,229, 13, 13,130,230,230,230,186,186, - 198, 85, 85,254,174,174,255,169,169,255,168,168,255,119,119,205,246, - 246,246,255,255,255,255,255,255,218,218,224,118,118,228,175,175,255, - 169,169,255,169,169,255, 60, 60,222,233,233,233,242,242,242,127,127, - 208,187,187,255,187,187,255,122,122,207,246,246,246,255,255,255,255, - 255,255,255,255,255,255,255,255,218,218,224,126,126,228,200,200,255, - 164,164,255,152,152,199,253,253,253,255,255,255,249,249,249,126,126, - 210,127,127,214,248,248,248,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,218,218,224,121,121,231,154,154,197, - 255,255,255,255,255,255); - -Const - stdimg_edit_cut_16 : Array[0..821] of byte = ( - 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, - 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, - 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0,255,255,255,172,172,226, 37, 37,178, 26, 26,175, 29, 29, - 174,209,209,239,255,255,255,255,255,255,255,255,255,255,255,255,172, - 172,226, 70, 70,190, 27, 27,176, 39, 39,179,209,209,239,255,255,255, - 255,255,255, 49, 49,182, 41, 41,219, 36, 36,209, 31, 31,206, 31, 31, - 177,209,209,239,255,255,255,255,255,255,209,209,239, 29, 29,177, 36, - 36,212, 34, 34,208, 31, 31,206, 39, 39,178,255,255,255,255,255,255, - 19, 19,173, 33, 33,208,255,255,255,117,117,213, 35, 35,211, 52, 52, - 184,255,255,255,255,255,255, 59, 59,187, 37, 37,214,114,114,214,255, - 255,255, 35, 35,210, 22, 22,173,255,255,255,255,255,255, 43, 43,179, - 37, 37,213,134,134,213,255,255,255, 38, 38,208, 13, 13,170,255,255, - 255,255,255,255, 5, 5,169, 38, 39,205,255,255,255,137,137,214, 34, - 34,209, 43, 43,179,255,255,255,255,255,255,172,172,226, 7, 7,168, - 35, 35,209, 73, 73,192, 26, 27,194, 1, 1,166,255,255,255,241,242, - 250, 30, 31,205, 25, 27,193, 74, 74,193, 33, 33,206, 7, 7,167,143, - 143,216,255,255,255,255,255,255,255,255,255,142,142,215, 9, 9,170, - 34, 34,210, 31, 31,206, 16, 17,184, 92, 94,196, 6, 7,169, 26, 26, - 201, 34, 34,209, 33, 33,203, 12, 12,170,171,171,225,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,127,127,210, - 33, 33,175, 6, 6,166, 70, 75,163, 2, 2,166, 25, 26,199, 37, 37, - 178,131,131,211,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,212,214,213, - 132,137,137,195,198,197,175,178,179, 52, 55,160,231,232,232,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,181,184,183,184,188,187, - 230,232,231,167,172,170,139,144,142,184,187,186,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,231,232,232,136,141,139,223,225,225,245,246,245, - 151,156,154,165,169,168,140,145,143,231,232,232,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,152,156,154,178,182,181,247,247,247,142,147,145,156,160,159, - 179,182,181,182,187,185,172,175,174,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,255,255,255,228,229,229,136, - 141,139,217,220,219,239,240,239,171,175,173,184,187,186,179,184,182, - 203,206,205,137,142,140,197,199,198,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,255,255,255,144,148,146,176,181,179,246, - 247,247,155,159,157,202,204,203,255,255,255,141,146,144,201,206,204, - 172,176,175,156,160,159,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,255,255,255,136,141,139,208,212,210,239,240,239,179, - 183,181,255,255,255,255,255,255,225,227,226,167,172,170,195,200,198, - 142,147,145,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,255,255,255,143,148,146,247,247,247,170,173,172,202,204,203,255, - 255,255,255,255,255,255,255,255,152,156,155,208,211,210,169,173,171, - 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, - 255,221,223,222,145,149,148,162,166,165,255,255,255,255,255,255,255, - 255,255,255,255,255,185,187,186,148,152,150,255,255,255,255,255,255, - 255,255,255,255,255,255); diff --git a/prototypes/fpgui2/source/core/x11/_netlayer.pas b/prototypes/fpgui2/source/core/x11/_netlayer.pas deleted file mode 100644 index 724b6e4b..00000000 --- a/prototypes/fpgui2/source/core/x11/_netlayer.pas +++ /dev/null @@ -1,1030 +0,0 @@ -unit _netlayer; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, X, XLib, XUtil, XAtom, ctypes; - -type - TNetMaximizedState = (nmsNone, nmsHorz, nmsVert, nmsBoth); - TNetWindowType = (nwtDesktop, nwtDock, nwtToolBar, nwtMenu, nwtUtility, nwtSplash, - nwtDialog, nwtDropdownMenu, nwtPopupMenu, nwtToolTip, - nwtNotification, nwtCombo, nwtDND, nwtNormal); - TNetWindowTypes = set of TNetWindowType; - - TNetWindowState = (nwsModal, nwsSticky, nwsMaxVert, nwsMaxHorz, nwsShaded, nwsSkipTaskBar, - nwsSkipPager, nwsHidden, nwsFullScreen, nwsAbove, nwsBelow, nwsDemandsAttn); - TNetWindowStates = set of TNetWindowState; - - TNetWindowAction = (nwaMove, nwaResize, nwaMinimize, nwaShade, nwaStick, nwaMaxHorz, - nwaMaxVert, nwaFullscreen, nwaChangeDesktop, nwaClose); - - TNetWindowActions = set of TNetWindowAction; - - PNetAtom = ^TNetAtom; - TNetAtom = TAtom; - - TNetAtomEnum = ( - naSUPPORTED, - naCLIENT_LIST, // array of TWindow - naCLIENT_LIST_STACKING, // array of TWindow (bottom to top) - naNUMBER_OF_DESKTOPS, // cardinal - naDESKTOP_GEOMETRY, // array [0..1] of cardinal (width height) - naDESKTOP_VIEWPORT, // array of cardinal array [0..1] viewports (top left position) - naCURRENT_DESKTOP, // cardinal (index of desktop) - naDESKTOP_NAMES, // array of null terminated UTF8 Strings - naACTIVE_WINDOW, // TWindow - naWORKAREA, // array [0..3] of cardinal (x, y, width, height) - naSUPPORTING_WM_CHECK, // TWindow - naVIRTUAL_ROOTS, // array of TWindow - naDESKTOP_LAYOUT, // array [0..3] of cardinal (orientation, columns, rows, starting_corner) - naSHOWING_DESKTOP, // ca - //Root Window Messages - naCLOSE_WINDOW, - naMOVERESIZE_WINDOW, - naWM_MOVERESIZE, - naRESTACK_WINDOW, - naREQUEST_FRAME_EXTENTS, - //Application Window Properties - naWM_NAME, // UTF8 String - naWM_VISIBLE_NAME, //UTF8 String - naWM_ICON_NAME, // UTF8 String - naWM_VISIBLE_ICON_NAME, // UTF8 String - naWM_DESKTOP, // cardinal (index of the desktop of the window) $FFFFFFFF for all desktops - naWM_WINDOW_TYPE, // TAtom of the different types below - naWM_WINDOW_TYPE_DESKTOP, - naWM_WINDOW_TYPE_DOCK, - naWM_WINDOW_TYPE_TOOLBAR, - naWM_WINDOW_TYPE_MENU, - naWM_WINDOW_TYPE_UTILITY, - naWM_WINDOW_TYPE_SPLASH, - naWM_WINDOW_TYPE_DIALOG, - naWM_WINDOW_TYPE_NORMAL, - naWM_WINDOW_TYPE_DROPDOWN_MENU, - naWM_WINDOW_TYPE_POPUP_MENU, - naWM_WINDOW_TYPE_TOOLTIP, - naWM_WINDOW_TYPE_NOTIFICATION, - naWM_WINDOW_TYPE_COMBO, - naWM_WINDOW_TYPE_DND, - naWM_STATE, // array of TAtoms. Possible members are listed below. others should be ignored - naWM_STATE_MODAL, - naWM_STATE_STICKY, - naWM_STATE_MAXIMIZED_VERT, - naWM_STATE_MAXIMIZED_HORZ, - naWM_STATE_SHADED, - naWM_STATE_SKIP_TASKBAR, - naWM_STATE_SKIP_PAGER, - naWM_STATE_HIDDEN, - naWM_STATE_FULLSCREEN, - naWM_STATE_ABOVE, - naWM_STATE_BELOW, - naWM_STATE_DEMANDS_ATTENTION, - naWM_ALLOWED_ACTIONS, //array of TAtoms below. unknown atoms are ignored - naWM_ACTION_MOVE, - naWM_ACTION_RESIZE, - naWM_ACTION_MINIMIZE, - naWM_ACTION_SHADE, - naWM_ACTION_STICK, - naWM_ACTION_MAXIMIZE_HORZ, - naWM_ACTION_MAXIMIZE_VERT, - naWM_ACTION_FULLSCREEN, - naWM_ACTION_CHANGE_DESKTOP, - naWM_ACTION_CLOSE, - naWM_STRUT, // array [0..3] of cardinal (left right top bottom) - naWM_STRUT_PARTIAL, // array [0..11] of cardinal (left, right, top, bottom, - // left_start_y, left_end_y, right_start_y, right_end_y, - // top_start_x, top_end_x, bottom_start_x, bottom_end_x ) - naWM_ICON_GEOMETRY, // array [0..3] of cardinal (x, y, width, height) - naWM_ICON, // array of cardinal the first two in the array are the width height - // and the rest of the array is the icon data in BGRA order - naWM_PID, // cardinal (process id of the window) - naWM_HANDLED_ICONS, - naWM_USER_TIME, // cardinal (XServer time of last user activity) - - naFRAME_EXTENTS, // array [0..3] of cardinal (left, right, top ,bottom) - - //Window Manager Protocols - naWM_PING, - naWM_SYNC_REQUEST - ); - - TNetAtomsSet = set of TNetAtomEnum; - - { TNETWindowLayer } - - TNETWindowLayer = class - private - FDisplay: PXDisplay; - FRootWindow: TWindow; - FNetAtoms: array[TNetAtomEnum] of TNetAtom; - UTF8_STRING: TAtom; - FAtomSupported: array[TNetAtomEnum] of Boolean; - FTimeStamp: LongInt; - procedure InitNetAtoms; - procedure UpdateSupportedAtoms; - public - // window related functions - function WindowSetName(const AWindow: TWindow; AName: PChar): Boolean; - function WindowGetHidden(const AWindow: TWindow; out AValue: Boolean): Boolean; - function WindowSetHidden(const AWindow: TWindow; const AValue: Boolean): Boolean; - function WindowGetMaximizedState(const AWindow: TWindow; out AValue: TNetMaximizedState): Boolean; - function WindowSetMaximizedState(const AWindow: TWindow; const AValue: TNetMaximizedState): Boolean; - function WindowSetFullscreen(const AWindow: TWindow; const AValue: Boolean): Boolean; - function WindowGetFullscreen(const AWindow: TWindow; out AValue: Boolean): Boolean; - function WindowSetDesktop(const AWindow: TWindow; const ADesktopIndex: Integer): Boolean; - function WindowGetDesktop(const AWindow: TWindow; out ADesktopIndex: Integer): Boolean; - function WindowMoveResize(const AWindow: TWindow; const AX, AY, AWidth, AHeight: Integer): Boolean; - function WindowMove(const AWindow: TWindow; const AX, AY: Integer): Boolean; - function WindowSetSticky(const AWindow: TWindow; const AValue: Boolean): Boolean; - function WindowGetSticky(const AWindow: TWindow; out AValue: Boolean): Boolean; - procedure WindowSetPID(const AWindow: TWindow; const APID: Integer); - function WindowGetFrameExtents(const AWindow: TWindow; out ATopHeight, ALeftWidth, ARightWidth, ABottomHeight: Integer): Boolean; - procedure WindowSetSupportPING(const AWindow: TWindow); - procedure WindowReplyToPING(const AWindow: TWindow; AClientMessage: PXClientMessageEvent); - function WindowGetState(const AWindow: TWindow; out AWindowState: TNetWindowStates): Boolean; - procedure WindowDemandsAttention(const AWindow: TWindow); - procedure WindowSetSkipTaskbar(const AWindow: TWindow; const AValue: Boolean); - procedure WindowSetSkipPager(const AWindow: TWindow; const AValue: Boolean); - function WindowGetType(const AWindow: TWindow; out AWindowType: TNetWindowTypes): Boolean; - procedure WindowSetType(const AWindow: TWindow; const AWindowType: TNetWindowTypes); - procedure WindowAddProtocol(const AWindow: TWindow; AProtocol: TAtom); - function WindowGetAllowedActions(const AWindow: TWindow; var AActions: TNetWindowActions): Boolean; - // windowmanager functions - function ManagerCloseWindow(const AWindow: TWindow): Boolean; - function ManagerGetActiveWindow(out AWindow: TWindow): Boolean; - function ManagerSetActiveWindow(const AWindow: TWindow): Boolean; - function ManagerIsValid: Boolean; - // desktop functions - function DesktopGetSize(out AWidth, AHeight: Integer): Boolean; - function DesktopGetCurrent(out AIndex: Integer): Boolean; - function DesktopSetCurrent(const AIndex: Integer): Boolean; - function DesktopGetCount(out Desktops: Integer): Boolean; - function DesktopIsShowing: Boolean; - // misc - function SendMessage(AWindow: TWindow; APropagate: Boolean; AMask: LongInt; AMessage: PXEvent): TStatus; - procedure SendRootWindowMessage(AMessage: PXEvent); - procedure SendRootWindowClientMessage(AMessage: PXClientMessageEvent); - // property setting and getting routines - function WindowGetPropertyAtom(const AWindow: TWindow; AProperty: TAtom; var Count: Integer; var Atoms: PAtom): Boolean; - procedure WindowSetPropertyAtom(const AWindow: TWindow; AProperty: TAtom; Count: Integer; Atoms: PAtom); - function WindowGetPropertyCardinal(const AWindow: TWindow; AProperty: TAtom; var Count: Integer; var Cards: PLongWord): Boolean; - procedure WindowSetPropertyCardinal(const AWindow: TWindow; AProperty: TAtom; Count: Integer; Cards: PLongInt); - function WindowGetPropertyWindow(const AWindow: TWindow; AProperty: TAtom; var Count: Integer; var Windows: PWindow): Boolean; - procedure WindowSetPropertyWindow(const AWindow: TWindow; AProperty: TAtom; Count: Integer; Windows: PWindow); - function WindowGetPropertyUTF8(const AWindow: TWindow; AProperty: TAtom; var ALength: Integer; var UTF8Text: String): Boolean; - procedure WindowSetPropertyUTF8(const AWindow: TWindow; AProperty: TAtom; ALength: Integer; UTF8Text: String); - - constructor Create(ADisplay: PXDisplay); - destructor Destroy; override; - end; - - const - NetAtomStr: array[TNetAtomEnum] of String = ( - '_NET_SUPPORTED', - '_NET_CLIENT_LIST', - '_NET_CLIENT_LIST_STACKING', - '_NET_NUMBER_OF_DESKTOPS', - '_NET_DESKTOP_GEOMETRY', - '_NET_DESKTOP_VIEWPORT', - '_NET_CURRENT_DESKTOP', - '_NET_DESKTOP_NAMES', - '_NET_ACTIVE_WINDOW', - '_NET_WORKAREA', - '_NET_SUPPORTING_WM_CHECK', - '_NET_VIRTUAL_ROOTS', - '_NET_DESKTOP_LAYOUT', - '_NET_SHOWING_DESKTOP', - '_NET_CLOSE_WINDOW', - '_NET_MOVERESIZE_WINDOW', - '_NET_WM_MOVERESIZE', - '_NET_RESTACK_WINDOW', - '_NET_REQUEST_FRAME_EXTENTS', - '_NET_WM_NAME', - '_NET_WM_VISIBLE_NAME', - '_NET_WM_ICON_NAME', - '_NET_WM_VISIBLE_ICON_NAME', - '_NET_WM_DESKTOP', - '_NET_WM_WINDOW_TYPE', - '_NET_WM_WINDOW_TYPE_DESKTOP', - '_NET_WM_WINDOW_TYPE_DOCK', - '_NET_WM_WINDOW_TYPE_TOOLBAR', - '_NET_WM_WINDOW_TYPE_MENU', - '_NET_WM_WINDOW_TYPE_UTILITY', - '_NET_WM_WINDOW_TYPE_SPLASH', - '_NET_WM_WINDOW_TYPE_DIALOG', - '_NET_WM_WINDOW_TYPE_NORMAL', - '_NET_WM_WINDOW_TYPE_DROPDOWN_MENU', - '_NET_WM_WINDOW_TYPE_POPUP_MENU', - '_NET_WM_WINDOW_TYPE_TOOLTIP', - '_NET_WM_WINDOW_TYPE_NOTIFICATION', - '_NET_WM_WINDOW_TYPE_COMBO', - '_NET_WM_WINDOW_TYPE_DND', - - '_NET_WM_STATE', - '_NET_WM_STATE_MODAL', - '_NET_WM_STATE_STICKY', - '_NET_WM_STATE_MAXIMIZED_VERT', - '_NET_WM_STATE_MAXIMIZED_HORZ', - '_NET_WM_STATE_SHADED', - '_NET_WM_STATE_SKIP_TASKBAR', - '_NET_WM_STATE_SKIP_PAGER', - '_NET_WM_STATE_HIDDEN', - '_NET_WM_STATE_FULLSCREEN', - '_NET_WM_STATE_ABOVE', - '_NET_WM_STATE_BELOW', - '_NET_WM_STATE_DEMANDS_ATTENTION', - - '_NET_WM_ALLOWED_ACTIONS', - '_NET_WM_ACTION_MOVE', - '_NET_WM_ACTION_RESIZE', - '_NET_WM_ACTION_MINIMIZE', - '_NET_WM_ACTION_SHADE', - '_NET_WM_ACTION_STICK', - '_NET_WM_ACTION_MAXIMIZE_HORZ', - '_NET_WM_ACTION_MAXIMIZE_VERT', - '_NET_WM_ACTION_FULLSCREEN', - '_NET_WM_ACTION_CHANGE_DESKTOP', - '_NET_WM_ACTION_CLOSE', - - '_NET_WM_STRUT', - '_NET_WM_STRUT_PARTIAL', - '_NET_WM_ICON_GEOMETRY', - '_NET_WM_ICON', - '_NET_WM_PID', - '_NET_WM_HANDLED_ICONS', - '_NET_WM_USER_TIME', - '_NET_FRAME_EXTENTS', - '_NET_WM_PING', - '_NET_WM_SYNC_REQUEST'); - - _NET_SOURCE_APPLICATION = 1; - _NET_SOURCE_PAGER = 2; - - _NET_WM_STATE_REMOVE = 0; // remove/unset property - _NET_WM_STATE_ADD = 1; // add/set property - _NET_WM_STATE_TOGGLE = 2; // toggle property - - -implementation -{ TNETWindowLayer } - -procedure TNETWindowLayer.InitNetAtoms; -var - NetAtom: TNetAtomEnum; -begin - for NetAtom := Low(TNetAtomEnum) to High(TNetAtomEnum) do begin - FNetAtoms[NetAtom] := XInternAtom(FDisplay, PChar(NetAtomStr[NetAtom]), True) - end; - UTF8_STRING := XInternAtom(FDisplay, 'UTF8_STRING', True); -end; - -procedure TNETWindowLayer.UpdateSupportedAtoms; -var - AtomCount: Integer; - Atoms: PNetAtom; - Data: Pointer; - I: Integer; - NetAtom: TNetAtomEnum; -begin - if WindowGetPropertyAtom(FRootWindow, FNetAtoms[naSUPPORTED], AtomCount, Atoms) = False then;// Exit; - //WriteLn('RootWindow Atom Count = ',AtomCount); - FillChar(FAtomSupported, SizeOf(Boolean) * Length(FAtomSupported), 0);; - for I := 0 to AtomCount-1 do begin - for NetAtom := Low(TNetAtomEnum) to High(TNetAtomEnum) do begin - if Atoms[I] = FNetAtoms[NetAtom] then begin - FAtomSupported[NetAtom] := True; - //WriteLn('Found ', NetAtomStr[NetAtom]); - end; - end; - end; - if AtomCount > 0 then - XFree(Atoms); -end; - -function TNETWindowLayer.WindowSetName(const AWindow: TWindow; AName: PChar - ): Boolean; -begin - WindowSetPropertyUTF8(AWindow, FNetAtoms[naWM_NAME], Length(AName), AName); -end; - -function TNETWindowLayer.WindowGetHidden(const AWindow: TWindow; out AValue: Boolean - ): Boolean; -var - WinState: TNetWindowStates; -begin - Result := FAtomSupported[naWM_STATE] and FAtomSupported[naWM_STATE_HIDDEN] - and WindowGetState(AWindow, WinState); - if not Result then Exit; - AValue := nwsHidden in WinState; -end; - -function TNETWindowLayer.WindowSetHidden(const AWindow: TWindow; const AValue: Boolean): Boolean; -var - Msg: TXClientMessageEvent; -begin - Result := FAtomSupported[naWM_STATE] and FAtomSupported[naWM_STATE_HIDDEN]; - if Result = False then Exit; - Result := True; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.message_type := FNetAtoms[naWM_STATE]; - Msg.window := AWindow; - Msg.data.l[0] := Ord(AValue); - Msg.data.l[1] := FNetAtoms[naWM_STATE_HIDDEN]; - Msg.data.l[3] := _NET_SOURCE_APPLICATION; - - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.WindowGetMaximizedState(const AWindow: TWindow; out - AValue: TNetMaximizedState): Boolean; -var - WinState: TNetWindowStates; -begin - Result := WindowGetState(AWindow, WinState); - AValue := nmsNone; - if Result then begin - if nwsMaxHorz in WinState then AValue := nmsHorz; - if (nwsMaxVert in WinState) then begin - if (AValue = nmsHorz) then AValue := nmsBoth - else AValue := nmsVert; - end; - end; -end; - -function TNETWindowLayer.WindowSetMaximizedState(const AWindow: TWindow; - const AValue: TNetMaximizedState): Boolean; -var - Msg: TXClientMessageEvent; -begin - Result := FAtomSupported[naWM_STATE] - and FAtomSupported[naWM_STATE_MAXIMIZED_HORZ] - and FAtomSupported[naWM_STATE_MAXIMIZED_VERT]; - if Result = False then Exit; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.message_type := FNetAtoms[naWM_STATE]; - Msg.window := AWindow; - - if AValue <> nmsNone then begin - Msg.data.l[0] := _NET_WM_STATE_ADD; - Msg.data.l[3] := _NET_SOURCE_APPLICATION; - - if AValue = nmsHorz then Msg.data.l[1] := FNetAtoms[naWM_STATE_MAXIMIZED_HORZ]; - if AValue = nmsVert then Msg.data.l[1] := FNetAtoms[naWM_STATE_MAXIMIZED_VERT]; - if AValue = nmsBoth then begin - Msg.data.l[1] := FNetAtoms[naWM_STATE_MAXIMIZED_VERT]; - Msg.data.l[2] := FNetAtoms[naWM_STATE_MAXIMIZED_HORZ]; - end; - SendRootWindowClientMessage(@Msg); - end; - - if AValue = nmsBoth then Exit; - // now remove properties we dont want - - Msg.data.l[0] := _NET_WM_STATE_REMOVE; - Msg.data.l[1] := 0; - Msg.data.l[2] := 0; - Msg.data.l[3] := _NET_SOURCE_APPLICATION; - - if AValue = nmsHorz then Msg.data.l[1] := FNetAtoms[naWM_STATE_MAXIMIZED_VERT]; - if AValue = nmsVert then Msg.data.l[1] := FNetAtoms[naWM_STATE_MAXIMIZED_HORZ]; - if AValue = nmsNone then begin - Msg.data.l[1] := FNetAtoms[naWM_STATE_MAXIMIZED_HORZ]; - Msg.data.l[2] := FNetAtoms[naWM_STATE_MAXIMIZED_VERT]; - end; - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.WindowSetFullscreen(const AWindow: TWindow; - const AValue: Boolean): Boolean; -var - Msg: TXClientMessageEvent; -begin - Result := FAtomSupported[naWM_STATE] and FAtomSupported[naWM_STATE_FULLSCREEN]; - if Result = False then Exit; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.message_type := FNetAtoms[naWM_STATE]; - Msg.window := AWindow; - Msg.data.l[0] := Ord(AValue); - Msg.data.l[1] := FNetAtoms[naWM_STATE_FULLSCREEN]; - Msg.data.l[3] := _NET_SOURCE_APPLICATION; - - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.WindowGetFullscreen(const AWindow: TWindow; out - AValue: Boolean): Boolean; -var - WinState: TNetWindowStates; -begin - Result := WindowGetState(AWindow, WinState); - - if Result then AValue := nwsFullScreen in WinState; -end; - -function TNETWindowLayer.WindowSetDesktop(const AWindow: TWindow; - const ADesktopIndex: Integer): Boolean; -var - Msg: TXClientMessageEvent; -begin - Result := FAtomSupported[naWM_DESKTOP]; - if Result = False then Exit; - - Msg.message_type := FNetAtoms[naWM_DESKTOP]; - Msg.window := AWindow; - Msg.data.l[0] := ADesktopIndex; - Msg.data.l[1] := _NET_SOURCE_APPLICATION; - - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.WindowGetDesktop(const AWindow: TWindow; out - ADesktopIndex: Integer): Boolean; -var - Index: PCardinal; - Count: LongInt; -begin - Result := FAtomSupported[naWM_DESKTOP] - and WindowGetPropertyCardinal(FRootWindow, FNetAtoms[naWM_DESKTOP], Count, Index); - if Result = False then Exit; - - ADesktopIndex := Index^; - if Count > 0 then XFree(Index); -end; - -function TNETWindowLayer.WindowMoveResize(const AWindow: TWindow; const AX, AY, - AWidth, AHeight: Integer): Boolean; -var - Msg: TXClientMessageEvent; -const - WSet = 1 shl 7; - HSet = 1 shl 6; - XSet = 1 shl 5; - YSet = 1 shl 4; - - FromPager = 1 shl 1; - FromApp = 1 shl 0; -begin - Result := FAtomSupported[naMOVERESIZE_WINDOW]; - if Result = False then Exit; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.message_type := FNetAtoms[naMOVERESIZE_WINDOW]; - Msg.window := AWindow; - Msg.data.s[0] := WSet or HSet or XSet or YSet or FromApp; // Gravity and flags - Msg.data.l[1] := AX; - Msg.data.l[2] := AY; - Msg.data.l[3] := AWidth; - Msg.data.l[4] := AHeight; - - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.WindowMove(const AWindow: TWindow; const AX, AY: Integer): Boolean; -var - Msg: TXClientMessageEvent; -const - WSet = 1 shl 7; - HSet = 1 shl 6; - XSet = 1 shl 5; - YSet = 1 shl 4; - FromApp = 1 shl 0; - FromPager = 1 shl 1; -begin - Result := FAtomSupported[naMOVERESIZE_WINDOW]; - if Result = False then Exit; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.message_type := FNetAtoms[naMOVERESIZE_WINDOW]; - Msg.window := AWindow; - Msg.data.b[0] := 0; // Gravity and flags - Msg.data.b[1] := XSet or YSet or FromApp; - Msg.data.b[2] := 0; - Msg.data.b[3] := 0; // this does nothing - Msg.data.l[1] := AX; - Msg.data.l[2] := AY; - - SendRootWindowClientMessage(@Msg); - -end; - -function TNETWindowLayer.WindowSetSticky(const AWindow: TWindow; - const AValue: Boolean): Boolean; -var - Msg: TXClientMessageEvent; -begin - Result := FAtomSupported[naWM_STATE] and FAtomSupported[naWM_STATE_STICKY]; - if Result = False then Exit; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.window := AWindow; - Msg.message_type := FNetAtoms[naWM_STATE]; - Msg.data.l[0] := Ord(AValue); - Msg.data.l[1] := FNetAtoms[naWM_STATE_STICKY]; - Msg.data.l[3] := _NET_SOURCE_APPLICATION; - - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.WindowGetSticky(const AWindow: TWindow; out AValue: Boolean - ): Boolean; -var - WinState: TNetWindowStates; -begin - Result := WindowGetState(AWindow, WinState); - - if Result then AValue := nwsSticky in WinState; -end; - -procedure TNETWindowLayer.WindowSetPID(const AWindow: TWindow; const APID: Integer); -begin -end; - -function TNETWindowLayer.WindowGetFrameExtents(const AWindow: TWindow; out - ATopHeight, ALeftWidth, ARightWidth, ABottomHeight: Integer): Boolean; -var - Sizes: PCardinal; - Count: LongInt; -begin - Result := FAtomSupported[naFRAME_EXTENTS]; - if Result = False then Exit; - Result := WindowGetPropertyCardinal(FRootWindow, FNetAtoms[naFRAME_EXTENTS], Count, Sizes); - if Count = 4 then begin - ALeftWidth := Sizes[0]; - ARightWidth := Sizes[1]; - ATopHeight := Sizes[2]; - ABottomHeight := Sizes[3]; - end - else Result := False; - if Count > 0 then XFree(Sizes); -end; - -procedure TNETWindowLayer.WindowSetSupportPING(const AWindow: TWindow); -begin - WindowAddProtocol(AWindow, FNetAtoms[naWM_PING]); -end; - -procedure TNETWindowLayer.WindowReplyToPING(const AWindow: TWindow; - AClientMessage: PXClientMessageEvent); -begin - AClientMessage^.window := FRootWindow; - SendRootWindowMessage(PXEvent(AClientMessage)); -end; - -function TNETWindowLayer.ManagerCloseWindow(const AWindow: TWindow): Boolean; -var - Msg: TXClientMessageEvent; -begin - Result := FAtomSupported[naCLOSE_WINDOW]; - if Result =False then Exit; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.window := AWindow; - Msg.message_type := FNetAtoms[naCLOSE_WINDOW]; - Msg.data.l[0] := FTimeStamp; - Msg.data.l[1] := _NET_SOURCE_APPLICATION; - - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.ManagerGetActiveWindow(out AWindow: TWindow): Boolean; -var - ActiveWindow: PWindow; - Count: LongInt; -begin - Result := FAtomSupported[naACTIVE_WINDOW]; - if Result = False then Exit; - Result := WindowGetPropertyWindow(FRootWindow, FNetAtoms[naACTIVE_WINDOW], Count, ActiveWindow); - if Count = 1 then - AWindow := ActiveWindow^; - if Count > 0 then XFree(ActiveWindow); -end; - -function TNETWindowLayer.ManagerSetActiveWindow(const AWindow: TWindow): Boolean; -var - Msg: TXClientMessageEvent; -begin - Result := FAtomSupported[naACTIVE_WINDOW]; - if Result = False then Exit; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.window := AWindow; - Msg.message_type := FNetAtoms[naACTIVE_WINDOW]; - Msg.data.l[0] := _NET_SOURCE_APPLICATION; - Msg.data.l[1] := FTimeStamp; - Msg.data.l[2] := 0; // our current active window - - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.ManagerIsValid: Boolean; -begin - -end; - -procedure TNETWindowLayer.SendRootWindowMessage(AMessage: PXEvent); -begin - SendMessage(FRootWindow, False, SubstructureNotifyMask or SubstructureRedirectMask, AMessage); -end; - -procedure TNETWindowLayer.SendRootWindowClientMessage(AMessage: PXClientMessageEvent - ); -begin - AMessage^.format := 32; - AMessage^._type := ClientMessage; - SendRootWindowMessage(PXEvent(AMessage)); -end; - -function TNETWindowLayer.WindowGetPropertyAtom(const AWindow: TWindow; AProperty: TAtom; - var Count: Integer; var Atoms: PAtom): Boolean; -var - atomtype: TAtom; - format: cint; - nitems: culong; - bytes_after: culong; -begin - Result := False; - XGetWindowProperty (FDisplay, AWindow, AProperty, 0, MaxInt, False, XA_ATOM, @atomtype, @format, @nitems, - @bytes_after, @Atoms); - - if (atomtype = XA_ATOM) and (format = 32) then begin - Result := True; - Count := nitems; - end; -end; - -procedure TNETWindowLayer.WindowSetPropertyAtom(const AWindow: TWindow; - AProperty: TAtom; Count: Integer; Atoms: PAtom); -begin - XChangeProperty(FDisplay, AWindow, AProperty, XA_ATOM, 32, PropModeReplace, Pointer(Atoms), Count); -end; - -procedure TNETWindowLayer.WindowSetPropertyCardinal(const AWindow: TWindow; - AProperty: TAtom; Count: Integer; Cards: PLongInt); -begin - XChangeProperty(FDisplay, AWindow, AProperty, XA_CARDINAL, 32, PropModeReplace, Pointer(Cards), Count); -end; - -function TNETWindowLayer.WindowGetPropertyWindow(const AWindow: TWindow; - AProperty: TAtom; var Count: Integer; var Windows: PWindow): Boolean; -var - atomtype: TAtom; - format: cint; - nitems: culong; - bytes_after: culong; -begin - Result := False; - XGetWindowProperty (FDisplay, AWindow, AProperty, 0, MaxInt, False, XA_ATOM, @atomtype, @format, @nitems, - @bytes_after, @Windows); - - if (atomtype = XA_WINDOW) and (format = 32) then begin - Result := True; - Count := nitems; - end; - -end; - -procedure TNETWindowLayer.WindowSetPropertyWindow(const AWindow: TWindow; - AProperty: TAtom; Count: Integer; Windows: PWindow); -begin - XChangeProperty(FDisplay, AWindow, AProperty, XA_WINDOW, 32, PropModeReplace, Pointer(Windows), Count); -end; - -function TNETWindowLayer.WindowGetPropertyUTF8(const AWindow: TWindow; - AProperty: TAtom; var ALength: Integer; var UTF8Text: String): Boolean; -var - atomtype: TAtom; - format: cint; - nitems: culong; - bytes_after: culong; - Utf8Str: PChar; -begin - Result := False; - XGetWindowProperty (FDisplay, AWindow, AProperty, 0, MaxInt, False, XA_ATOM, @atomtype, @format, @nitems, - @bytes_after, @Utf8Str); - - if (atomtype = XA_WINDOW) and (format = 32) then begin - Result := True; - UTF8Text := Copy(Utf8Str, 0, nitems); - ALength := nitems; - end; - if nitems > 0 then XFree(Utf8Str); -end; - -procedure TNETWindowLayer.WindowSetPropertyUTF8(const AWindow: TWindow; - AProperty: TAtom; ALength: Integer; UTF8Text: String); -begin - XChangeProperty(FDisplay, AWindow, AProperty, UTF8_STRING, 8, PropModeReplace, @UTF8Text[1], ALength); -end; - -function TNETWindowLayer.WindowGetPropertyCardinal(const AWindow: TWindow; - AProperty: TAtom; var Count: Integer; var Cards: PLongWord): Boolean; -var - atomtype: TAtom; - format: cint; - nitems: culong; - bytes_after: culong; -begin - Result := False; - XGetWindowProperty (FDisplay, AWindow, AProperty, 0, MaxInt, False, XA_ATOM, @atomtype, @format, @nitems, - @bytes_after, @Cards); - - if (atomtype = XA_CARDINAL) and (format = 32) then begin - Result := True; - Count := nitems; - end; -end; - -procedure TNETWindowLayer.WindowAddProtocol(const AWindow: TWindow; AProtocol: TAtom); -var - Count: cint; - Protocols: PAtom; - NewProtocols: array of TAtom; -begin - XGetWMProtocols(FDisplay, AWindow, @Protocols, @Count); - - SetLength(NewProtocols, Count+1); - Move(Protocols[0], NewProtocols[0], SizeOf(TAtom)* Count); - NewProtocols[Count] := AProtocol; - - if Count > 0 then XFree(Protocols); - - XSetWMProtocols(FDisplay, AWindow, @NewProtocols, Count+1); -end; - -function TNETWindowLayer.WindowGetAllowedActions(const AWindow: TWindow; - var AActions: TNetWindowActions): Boolean; -var - AtomCount: Integer; - ActionAtoms: PAtom; - I: Integer; -begin - Result := FAtomSupported[naWM_ALLOWED_ACTIONS]; - if Result = False then Exit; - if WindowGetPropertyAtom(AWindow, FNetAtoms[naWM_ALLOWED_ACTIONS], AtomCount, ActionAtoms) = False then Exit(False); - AActions := []; - - //WriteLn('Getting Allowed Actions. ', AtomCount); - - for I := 0 to AtomCount-1 do begin - //WriteLn('Allowed ', XGetAtomName(FDisplay,ActionAtoms[I])); - if ActionAtoms[I] = FNetAtoms[naWM_ACTION_MOVE] then Include(AActions, nwaMove) - else if ActionAtoms[I] = FNetAtoms[naWM_ACTION_RESIZE] then Include(AActions, nwaResize) - else if ActionAtoms[I] = FNetAtoms[naWM_ACTION_MINIMIZE] then Include(AActions, nwaMinimize) - else if ActionAtoms[I] = FNetAtoms[naWM_ACTION_SHADE] then Include(AActions, nwaShade) - else if ActionAtoms[I] = FNetAtoms[naWM_ACTION_STICK] then Include(AActions, nwaStick) - else if ActionAtoms[I] = FNetAtoms[naWM_ACTION_MAXIMIZE_HORZ] then Include(AActions, nwaMaxHorz) - else if ActionAtoms[I] = FNetAtoms[naWM_ACTION_MAXIMIZE_VERT] then Include(AActions, nwaMaxVert) - else if ActionAtoms[I] = FNetAtoms[naWM_ACTION_FULLSCREEN] then Include(AActions, nwaFullscreen) - else if ActionAtoms[I] = FNetAtoms[naWM_ACTION_CHANGE_DESKTOP] then Include(AActions, nwaChangeDesktop) - else if ActionAtoms[I] = FNetAtoms[naWM_ACTION_CLOSE] then Include(AActions, nwaClose); - end; - if AtomCount > 0 then XFree(ActionAtoms); -end; - -function TNETWindowLayer.WindowGetState(const AWindow: TWindow; out - AWindowState: TNetWindowStates): Boolean; -var - AtomCount: Integer; - StateAtoms: PAtom; - Data: Pointer; - I: Integer; - State: TNetWindowState; -begin - Result := FAtomSupported[naWM_STATE]; - if Result = False then Exit; - if WindowGetPropertyAtom(AWindow, FNetAtoms[naWM_STATE], AtomCount, StateAtoms) = False then - Exit(False); - - AWindowState := []; - - for I := 0 to AtomCount-1 do begin - if StateAtoms[I] = FNetAtoms[naWM_STATE_MODAL] then Include(AWindowState, nwsModal) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_STICKY] then Include(AWindowState, nwsSticky) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_MAXIMIZED_VERT] then Include(AWindowState, nwsMaxVert) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_MAXIMIZED_HORZ] then Include(AWindowState, nwsMaxHorz) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_SHADED] then Include(AWindowState, nwsShaded) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_SKIP_TASKBAR] then Include(AWindowState, nwsSkipTaskBar) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_SKIP_PAGER] then Include(AWindowState, nwsSkipPager) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_HIDDEN] then Include(AWindowState, nwsHidden) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_FULLSCREEN] then Include(AWindowState, nwsFullScreen) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_ABOVE] then Include(AWindowState, nwsAbove) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_BELOW] then Include(AWindowState, nwsBelow) - else if StateAtoms[I] = FNetAtoms[naWM_STATE_DEMANDS_ATTENTION] then Include(AWindowState, nwsDemandsAttn); - end; - if AtomCount > 0 then - XFree(StateAtoms); -end; - -procedure TNETWindowLayer.WindowDemandsAttention(const AWindow: TWindow); -var - Msg: TXClientMessageEvent; -begin - if FAtomSupported[naWM_STATE] and FAtomSupported[naWM_STATE_DEMANDS_ATTENTION] = False then Exit; - - FillChar(Msg, SizeOf(Msg), 0); - - Msg.message_type := FNetAtoms[naWM_STATE]; - Msg.window := AWindow; - Msg.data.l[0] := _NET_WM_STATE_ADD; - Msg.data.l[1] := FNetAtoms[naWM_STATE_DEMANDS_ATTENTION]; - Msg.data.l[3] := _NET_SOURCE_APPLICATION; - - SendRootWindowClientMessage(@Msg); -end; - -procedure TNETWindowLayer.WindowSetSkipTaskbar(const AWindow: TWindow; - const AValue: Boolean); -var - Msg: TXClientMessageEvent; -begin - if FAtomSupported[naWM_STATE] and FAtomSupported[naWM_STATE_SKIP_TASKBAR] = False then Exit; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.message_type := FNetAtoms[naWM_STATE]; - Msg.window := AWindow; - Msg.data.l[0] := Ord(AValue); - Msg.data.l[1] := FNetAtoms[naWM_STATE_SKIP_TASKBAR]; - Msg.data.l[3] := _NET_SOURCE_APPLICATION; - - SendRootWindowClientMessage(@Msg); -end; - -procedure TNETWindowLayer.WindowSetSkipPager(const AWindow: TWindow; - const AValue: Boolean); -var - Msg: TXClientMessageEvent; -begin - if FAtomSupported[naWM_STATE] and FAtomSupported[naWM_STATE_SKIP_PAGER] = False then Exit; - - FillChar(Msg, SizeOf(Msg), 0); - - Msg.message_type := FNetAtoms[naWM_STATE]; - Msg.window := AWindow; - Msg.data.l[0] := Ord(AValue); - Msg.data.l[1] := FNetAtoms[naWM_STATE_SKIP_PAGER]; - Msg.data.l[3] := _NET_SOURCE_APPLICATION; - - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.WindowGetType(const AWindow: TWindow; out - AWindowType: TNetWindowTypes): Boolean; -var - WindowTypes: PAtom; - Count: LongInt; - I : Integer; -begin - Result := FAtomSupported[naWM_WINDOW_TYPE] - and WindowGetPropertyAtom(AWindow, FNetAtoms[naWM_WINDOW_TYPE], Count, WindowTypes); - if not Result then Exit; - - AWindowType := []; - for I := 0 to Count -1 do begin - if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_DESKTOP] then Include(AWindowType, nwtDesktop) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_DOCK] then Include(AWindowType, nwtDock) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_TOOLBAR] then Include(AWindowType, nwtToolBar) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_MENU] then Include(AWindowType, nwtMenu) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_UTILITY] then Include(AWindowType, nwtUtility) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_SPLASH] then Include(AWindowType, nwtSplash) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_DIALOG] then Include(AWindowType, nwtDialog) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_NORMAL] then Include(AWindowType, nwtNormal) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_DROPDOWN_MENU] then Include(AWindowType, nwtDropdownMenu) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_POPUP_MENU] then Include(AWindowType, nwtPopupMenu) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_TOOLTIP] then Include(AWindowType, nwtToolTip) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_NOTIFICATION] then Include(AWindowType, nwtNotification) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_COMBO] then Include(AWindowType, nwtCombo) - else if WindowTypes[I] = FNetAtoms[naWM_WINDOW_TYPE_DND] then Include(AWindowType, nwtDND); - end; - - - -end; - -procedure TNETWindowLayer.WindowSetType(const AWindow: TWindow; - const AWindowType: TNetWindowTypes); -var - WindowAtoms: array of TNetAtom; - - procedure AddWindowType(AType: TNetAtom); - var - CurrentLength: Integer; - begin - CurrentLength := Length(WindowAtoms); - SetLength(WindowAtoms, CurrentLength+1); - WindowAtoms[CurrentLength] := AType; - end; -var - WindowType: TNetWindowType; - AtomEnum: TNetAtomEnum; -begin - for WindowType := Low(TNetWindowType) to High(TNetWindowType) do begin - AtomEnum := TNetAtomEnum(Ord(naWM_WINDOW_TYPE_DESKTOP) + Ord(WindowType)); - if WindowType in AWindowType then AddWindowType(FNetAtoms[AtomEnum]); - end; -end; - -function TNETWindowLayer.DesktopGetSize(out AWidth, AHeight: Integer): Boolean; -var - Count : LongInt; - Sizes: PLongWord; -begin - Result := FAtomSupported[naDESKTOP_GEOMETRY] - and WindowGetPropertyCardinal(FRootWindow, FNetAtoms[naDESKTOP_GEOMETRY], Count, Sizes); - if not Result then Exit; - - if Count > 0 then begin - Result := False; - if Count = 2 then begin - AWidth := Sizes[0]; - AHeight := Sizes[1]; - Result := True; - end; - XFree(Sizes); - end; -end; - -function TNETWindowLayer.DesktopGetCurrent(out AIndex: Integer): Boolean; -var - Count : LongInt; - Index: PLongWord; -begin - Result := FAtomSupported[naCURRENT_DESKTOP] - and WindowGetPropertyCardinal(FRootWindow, FNetAtoms[naCURRENT_DESKTOP], Count, Index); - if not Result then Exit; - - AIndex := Index^; - - if Count > 0 then XFree(Index); -end; - -function TNETWindowLayer.DesktopSetCurrent(const AIndex: Integer): Boolean; -var - Msg: TXClientMessageEvent; -begin - Result := FAtomSupported[naCURRENT_DESKTOP]; - if Result = False then Exit; - FillChar(Msg, SizeOf(Msg), 0); - - Msg.message_type := FNetAtoms[naCURRENT_DESKTOP]; - Msg.data.l[0] := AIndex; - Msg.data.l[1] := FTimeStamp; - - SendRootWindowClientMessage(@Msg); -end; - -function TNETWindowLayer.DesktopGetCount(out Desktops: Integer): Boolean; -var - Count : LongInt; - Number: PLongWord; -begin - Result := FAtomSupported[naNUMBER_OF_DESKTOPS] - and WindowGetPropertyCardinal(FRootWindow, FNetAtoms[naNUMBER_OF_DESKTOPS], Count, Number); - if not Result then Exit; - - Desktops := PLongInt(Number)^; - - if Count > 0 then XFree(Number); -end; - -function TNETWindowLayer.DesktopIsShowing: Boolean; -var - Count : LongInt; - Showing: PLongWord; -begin - Result := FAtomSupported[naSHOWING_DESKTOP] - and WindowGetPropertyCardinal(FRootWindow, FNetAtoms[naSHOWING_DESKTOP], Count, Showing); - if not Result then Exit; - - Result := Showing^ = 1; - - if Count > 0 then XFree(Showing); -end; - -function TNETWindowLayer.SendMessage(AWindow: TWindow; APropagate: Boolean; - AMask: LongInt; AMessage: PXEvent): TStatus; -begin - Inc(FTimeStamp); - AMessage^.xany.display := FDisplay; - Result := XSendEvent(FDisplay, AWindow, APropagate, AMask, AMessage); -end; - -constructor TNETWindowLayer.Create(ADisplay: PXDisplay); -begin - FDisplay := ADisplay; - FRootWindow := XDefaultRootWindow(FDisplay); - InitNetAtoms; - UpdateSupportedAtoms; -end; - -destructor TNETWindowLayer.Destroy; -begin - inherited Destroy; -end; - -end. - diff --git a/prototypes/fpgui2/source/core/x11/fpGFX2.lpk b/prototypes/fpgui2/source/core/x11/fpGFX2.lpk deleted file mode 100644 index 5255aeb1..00000000 --- a/prototypes/fpgui2/source/core/x11/fpGFX2.lpk +++ /dev/null @@ -1,127 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <Package Version="2"> - <Name Value="fpGFX2"/> - <Author Value="Graeme Geldenhuys"/> - <CompilerOptions> - <Version Value="5"/> - <SearchPaths> - <IncludeFiles Value="../../"/> - <OtherUnitFiles Value="../;../../gui/"/> - <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <CodeGeneration> - <Optimizations> - <OptimizationLevel Value="0"/> - </Optimizations> - </CodeGeneration> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> - <Description Value="fpGFX redesign with multiple handles per window -"/> - <License Value="Modified LGPL -"/> - <Version Minor="1"/> - <Files Count="21"> - <Item1> - <Filename Value="x11_xft.pas"/> - <UnitName Value="x11_xft"/> - </Item1> - <Item2> - <Filename Value="x11_keyconv.pas"/> - <UnitName Value="x11_keyconv"/> - </Item2> - <Item3> - <Filename Value="../gfxbase.pas"/> - <UnitName Value="gfxbase"/> - </Item3> - <Item4> - <Filename Value="../gfxbaseinterfaces.pas"/> - <UnitName Value="gfxbaseinterfaces"/> - </Item4> - <Item5> - <Filename Value="gfx_x11.pas"/> - <UnitName Value="gfx_x11"/> - </Item5> - <Item6> - <Filename Value="../fpgfx.pas"/> - <UnitName Value="fpgfx"/> - </Item6> - <Item7> - <Filename Value="../gfx_stdimages.pas"/> - <UnitName Value="gfx_stdimages"/> - </Item7> - <Item8> - <Filename Value="../gfx_imgfmt_bmp.pas"/> - <UnitName Value="gfx_imgfmt_bmp"/> - </Item8> - <Item9> - <Filename Value="../gfx_widget.pas"/> - <UnitName Value="gfx_widget"/> - </Item9> - <Item10> - <Filename Value="../../gui/gui_form.pas"/> - <UnitName Value="gui_form"/> - </Item10> - <Item11> - <Filename Value="../../gui/gui_label.pas"/> - <UnitName Value="gui_label"/> - </Item11> - <Item12> - <Filename Value="../../gui/gui_button.pas"/> - <UnitName Value="gui_button"/> - </Item12> - <Item13> - <Filename Value="../../gui/gui_edit.pas"/> - <UnitName Value="gui_edit"/> - </Item13> - <Item14> - <Filename Value="../../gui/gui_combobox.pas"/> - <UnitName Value="gui_combobox"/> - </Item14> - <Item15> - <Filename Value="../../gui/gui_popupwindow.pas"/> - <UnitName Value="gui_popupwindow"/> - </Item15> - <Item16> - <Filename Value="../../gui/gui_scrollbar.pas"/> - <UnitName Value="gui_scrollbar"/> - </Item16> - <Item17> - <Filename Value="../gfx_utf8utils.pas"/> - <UnitName Value="gfx_UTF8utils"/> - </Item17> - <Item18> - <Filename Value="../../gui/gui_dialogs.pas"/> - <UnitName Value="gui_dialogs"/> - </Item18> - <Item19> - <Filename Value="../../gui/gui_listbox.pas"/> - <UnitName Value="gui_listbox"/> - </Item19> - <Item20> - <Filename Value="../../gui/gui_memo.pas"/> - <UnitName Value="gui_memo"/> - </Item20> - <Item21> - <Filename Value="../gfx_extinterpolation.pas"/> - <UnitName Value="gfx_extinterpolation"/> - </Item21> - </Files> - <RequiredPkgs Count="1"> - <Item1> - <PackageName Value="FCL"/> - <MinVersion Major="1" Valid="True"/> - </Item1> - </RequiredPkgs> - <UsageOptions> - <UnitPath Value="$(PkgOutDir)/"/> - </UsageOptions> - <PublishOptions> - <Version Value="2"/> - <IgnoreBinaries Value="False"/> - </PublishOptions> - </Package> -</CONFIG> diff --git a/prototypes/fpgui2/source/core/x11/fpGFX2.pas b/prototypes/fpgui2/source/core/x11/fpGFX2.pas deleted file mode 100644 index d4a75395..00000000 --- a/prototypes/fpgui2/source/core/x11/fpGFX2.pas +++ /dev/null @@ -1,17 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! -This source is only used to compile and install the package. - } - -unit fpGFX2; - -interface - -uses - x11_xft, x11_keyconv, gfxbase, gfxbaseinterfaces, gfx_x11, fpgfx, - gfx_stdimages, gfx_imgfmt_bmp, gfx_widget, gui_form, gui_label, gui_button, - gui_edit, gui_combobox, gui_popupwindow, gui_scrollbar, gfx_UTF8utils, - gui_dialogs, gui_listbox, gui_memo, gfx_extinterpolation; - -implementation - -end. diff --git a/prototypes/fpgui2/source/core/x11/gfx_x11.pas b/prototypes/fpgui2/source/core/x11/gfx_x11.pas deleted file mode 100644 index 99411c18..00000000 --- a/prototypes/fpgui2/source/core/x11/gfx_x11.pas +++ /dev/null @@ -1,1590 +0,0 @@ -unit gfx_x11; - -{$mode objfpc}{$H+} - -{$Define DEBUG} - -interface - -uses - Classes, - SysUtils, - X, - Xlib, - XUtil, - x11_xft, -// x11_keyconv, - gfxbase; - -type - TfpgWinHandle = TXID; - TfpgGContext = Xlib.TGc; - -type - PInt = ^integer; - - TXIC = record - dummy: Pointer; - end; - PXIC = ^TXIC; - - TXIM = record - dummy: Pointer; - end; - PXIM = ^TXIM; - - PXdbeSwapInfo = ^TXdbeSwapInfo; - - TXdbeSwapInfo = record - Window: TfpgWinHandle; - SwapAction: PChar; - end; - -type - TfpgWindowImpl = class; - - - TfpgFontResourceImpl = class(TfpgFontResourceBase) - private - FFontData: PXftFont; - protected - property Handle: PXftFont read FFontData; - public - constructor Create(const afontdesc: string); - destructor Destroy; override; - function HandleIsValid: boolean; - function GetAscent: integer; override; - function GetDescent: integer; override; - function GetHeight: integer; override; - function GetTextWidth(const txt: string): integer; override; - end; - - - TfpgImageImpl = class(TfpgImageBase) - private - FXimg: TXImage; - FXimgmask: TXImage; - function XImage: PXImage; - function XImageMask: PXImage; - protected - procedure DoFreeImage; override; - procedure DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); override; - procedure DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); override; - public - constructor Create; - end; - - - TfpgCanvasImpl = class(TfpgCanvasBase) - private - FDrawing: boolean; - FDrawWindow: TfpgWindowImpl; - FBufferPixmap: TPixmap; - FDrawHandle: TXID; - Fgc: TfpgGContext; - FCurFontRes: TfpgFontResourceImpl; - FClipRect: TfpgRect; - FClipRectSet: boolean; - FXftDraw: PXftDraw; - FXftDrawBuffer: PXftDraw; - FColorTextXft: TXftColor; - FClipRegion: TRegion; - protected - procedure DoSetFontRes(fntres: TfpgFontResourceBase); override; - procedure DoSetTextColor(cl: TfpgColor); override; - procedure DoSetColor(cl: TfpgColor); override; - procedure DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); override; - procedure DoGetWinRect(var r: TfpgRect); override; - procedure DoFillRectangle(x, y, w, h: TfpgCoord); override; - procedure DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); override; - procedure DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); override; - procedure DoDrawRectangle(x, y, w, h: TfpgCoord); override; - procedure DoDrawLine(x1, y1, x2, y2: TfpgCoord); override; - procedure DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); override; - procedure DoDrawString(x, y: TfpgCoord; const txt: string); override; - procedure DoSetClipRect(const rect: TfpgRect); override; - function DoGetClipRect: TfpgRect; override; - procedure DoAddClipRect(const rect: TfpgRect); override; - procedure DoClearClipRect; override; - procedure DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); override; - procedure DoPutBufferToScreen(x, y, w, h: TfpgCoord); override; - procedure DoEndDraw; override; - function GetPixel(X, Y: integer): TfpgColor; override; - procedure SetPixel(X, Y: integer; const AValue: TfpgColor); override; - public - constructor Create; override; - destructor Destroy; override; - end; - - - { TfpgWindowImpl } - - TfpgWindowImpl = class(TfpgWindowBase) - protected - FWinHandle: TfpgWinHandle; - FModalForWin: TfpgWindowImpl; - procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override; - procedure DoReleaseWindowHandle; override; - function HandleIsValid: boolean; override; - procedure DoSetWindowTitle(const ATitle: string); override; - procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); override; - function DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; override; - procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); override; - property WinHandle: TfpgWinHandle read FWinHandle; - public - constructor Create(AOwner: TComponent); override; - procedure CaptureMouse; override; - procedure ReleaseMouse; override; - end; - - - TfpgApplicationImpl = class(TfpgApplicationBase) - private - FComposeBuffer: String[32]; - FComposeStatus: TXComposeStatus; - function ConvertShiftState(AState: Cardinal): TShiftState; - function KeySymToKeycode(KeySym: TKeySym): Word; - function StartComposing(const Event: TXEvent): TKeySym; - protected - FDisplay: PXDisplay; - DisplayDepth: integer; - DefaultBackground: TfpgColor; - DefaultForeground: TfpgColor; - DefaultScreen: integer; - DefaultVisual: PVisual; - DefaultColorMap: TColorMap; - RootWindow: TfpgWinHandle; - xia_clipboard: TAtom; - xia_motif_wm_hints: TAtom; - xia_wm_protocols: TAtom; - xia_wm_delete_window: TAtom; - xia_wm_state: TAtom; - xia_wm_state_modal: TAtom; - xia_targets: TAtom; - InputMethod: PXIM; - InputContext: PXIC; - LastClickWindow: TfpgWinHandle; // double click generation - LastWinClickTime: longword; - public - constructor Create(const aparams: string); override; - destructor Destroy; override; - function DoMessagesPending: boolean; - procedure DoWaitWindowMessage(atimeoutms: integer); - procedure DoFlush; - function GetScreenWidth: TfpgCoord; - function GetScreenHeight: TfpgCoord; - property Display: PXDisplay read FDisplay; - end; - - -implementation - -uses - baseunix, - fpgfx, - gfx_widget, {$Note This dependency to gfx_widget must be removed.} - gui_form, // remove this!!!!! - xatom, - gfx_utf8utils, - _netlayer; - -var - xapplication: TfpgApplication; - -const - // map X11 event types to custom event types - MSG_SCROLL = 65; - MSG_RESIZE = 66; - MSG_POPUPCLOSE = 67; - MSG_MOVE = 68; - MSG_DOUBLECLICK = 69; - - - // some externals - -// defines: -procedure XRenderSetPictureClipRectangles(disp: PXDisplay; pic: TPicture; xorigin, yorigin: integer; rect: PXRectangle; num: integer); cdecl; external; - -// redefines: -function XmbLookupString(p1: PXIC; ev: PXKeyPressedEvent; str: PChar; len: longword; ks: PKeySym; stat: PStatus): longint; cdecl; external; - -// Double buffer functions -function XdbeQueryExtension(ADisplay: PXDisplay; AMajor, AMinor: PInt): PStatus; cdecl; external; -function XdbeAllocateBackBufferName(ADisplay: PXDisplay; AWindow: TfpgWinHandle; ASwapAction: PChar): TfpgWinHandle; cdecl; external; -function XdbeSwapBuffers(ADisplay: PXDisplay; ASwapInfo: PXdbeSwapInfo; AScreenNums: integer): PStatus; cdecl; external; -function XdbeDeallocateBackBufferName(ADisplay: PXDisplay; ABuffer: TfpgWinHandle): PStatus; cdecl; external; - -function XOpenIM(para1: PDisplay; para2: PXrmHashBucketRec; para3: Pchar; para4: Pchar): PXIM; cdecl; external; -function XCreateIC(para1: PXIM; para2: array of const): PXIC; cdecl; external; - - -function ConvertTo565Pixel(rgb: longword): word; -begin - Result := (rgb and $F8) shr 3; - Result := Result or ((rgb and $FC00) shr 5); - Result := Result or ((rgb and $F80000) shr 8); -end; - -function fpgColorToX(col: TfpgColor): longword; -var - xc: TXColor; - c: TfpgColor; -begin - c := fpgColorToRGB(col); - - if xapplication.DisplayDepth >= 24 then - Result := c - else if xapplication.DisplayDepth = 16 then - Result := ConvertTo565Pixel(c) - else - begin - c := col; - xc.blue := (c and $000000FF) shl 8; - xc.green := (c and $0000FF00); - xc.red := (c and $00FF0000) shr 8; - - // THIS CALL IS TOO SLOW !!!!!: - XAllocColor(xapplication.display, xapplication.DefaultColorMap, @xc); - Result := xc.pixel; - end; -end; - -procedure SetXftColor(col: TfpgColor; var colxft: TXftColor); -var - c: TfpgColor; -begin - c := fpgColorToRGB(col); - - colxft.color.blue := (c and $000000FF) shl 8; - colxft.color.green := (c and $0000FF00); - colxft.color.red := (c and $00FF0000) shr 8; - - colxft.color.alpha := (c and $7F000000) shr 15; - colxft.color.alpha := colxft.color.alpha xor $FFFF; // invert: 0 means not translucent - - colxft.pixel := 0; -end; - -type - PWindowLookupRec = ^WindowLookupRec; - - // single direction linked list - WindowLookupRec = record - w: TfpgWindowImpl; - Next: PWindowLookupRec; - end; - -var - FirstWindowLookupRec: PWindowLookupRec; - LastWindowLookupRec: PWindowLookupRec; - -procedure AddWindowLookup(w: TfpgWindowImpl); -var - p: PWindowLookupRec; -begin - if w = nil then - Exit; - - New(p); - p^.w := w; - p^.Next := nil; - if FirstWindowLookupRec = nil then - FirstWindowLookupRec := p - else - LastWindowLookupRec^.Next := p; - LastWindowLookupRec := p; -end; - -procedure RemoveWindowLookup(w: TfpgWindowImpl); -var - prevp: PWindowLookupRec; - p: PWindowLookupRec; - px: PWindowLookupRec; -begin - p := FirstWindowLookupRec; - prevp := nil; - - while p <> nil do - if p^.w = w then - begin - if prevp = nil then - FirstWindowLookupRec := p^.Next - else - prevp^.Next := p^.Next; - if LastWindowLookupRec = p then - LastWindowLookupRec := prevp; - px := p; - p := p^.Next; - Dispose(px); - end - else - begin - prevp := p; - p := p^.Next; - end; -end; - -function FindWindowByHandle(wh: TfpgWinHandle): TfpgWindowImpl; -var - p: PWindowLookupRec; -begin - p := FirstWindowLookupRec; - while p <> nil do - begin - if p^.w.WinHandle = wh then - begin - Result := p^.w; - Exit; - end; - p := p^.Next; - end; - Result := nil; -end; - -function GetXEventName(Event: longint): string; -const - EventNames: array[2..34] of string = ( - 'KeyPress', 'KeyRelease', 'ButtonPress', 'ButtonRelease', 'MotionNotify', - 'EnterNotify', 'LeaveNotify', 'FocusIn', 'FocusOut', 'KeymapNotify', - 'Expose', 'GraphicsExpose', 'NoExpose', 'VisibilityNotify', 'CreateNotify', - 'DestroyNotify', 'UnmapNotify', 'MapNotify', 'MapRequest', 'ReparentNotify', - 'ConfigureNotify', 'ConfigureRequest', 'GravityNotify', 'ResizeRequest', - 'CirculateNotify', 'CirculateRequest', 'PropertyNotify', 'SelectionClear', - 'SelectionRequest', 'SelectionNotify', 'ColormapNotify', 'ClientMessage', - 'MappingNotify'); -begin - if (Event >= Low(EventNames)) and (Event <= High(EventNames)) then - Result := EventNames[Event] - else - Result := '#' + IntToStr(Event); -end; - -{ TfpgApplicationImpl } - -function TfpgApplicationImpl.ConvertShiftState(AState: Cardinal): TShiftState; -begin - Result := []; - if (AState and Button1Mask) <> 0 then - Include(Result, ssLeft); - if (AState and Button2Mask) <> 0 then - Include(Result, ssMiddle); - if (AState and Button3Mask) <> 0 then - Include(Result, ssRight); - if (AState and ShiftMask) <> 0 then - Include(Result, ssShift); - if (AState and LockMask) <> 0 then - Include(Result, ssCaps); - if (AState and ControlMask) <> 0 then - Include(Result, ssCtrl); - if (AState and Mod1Mask) <> 0 then - Include(Result, ssAlt); - if (AState and Mod2Mask) <> 0 then - Include(Result, ssNum); - if (AState and Mod4Mask) <> 0 then - Include(Result, ssSuper); - if (AState and Mod5Mask) <> 0 then - Include(Result, ssScroll); - if (AState and (1 shl 13)) <> 0 then - Include(Result, ssAltGr); -end; - -function TfpgApplicationImpl.KeySymToKeycode(KeySym: TKeySym): Word; -const - Table_20aX: array[$20a0..$20ac] of Word = (keyEcuSign, keyColonSign, - keyCruzeiroSign, keyFFrancSign, keyLiraSign, keyMillSign, keyNairaSign, - keyPesetaSign, keyRupeeSign, keyWonSign, keyNewSheqelSign, keyDongSign, - keyEuroSign); - Table_feXX: array[$fe50..$fe60] of Word = (keyDeadGrave, keyDeadAcute, - keyDeadCircumflex, keyDeadTilde, keyDeadMacron,keyDeadBreve, - keyDeadAbovedot, keyDeadDiaeresis, keyDeadRing, keyDeadDoubleacute, - keyDeadCaron, keyDeadCedilla, keyDeadOgonek, keyDeadIota, - keyDeadVoicedSound, keyDeadSemivoicedSound, keyDeadBelowdot); - Table_ff5X: array[$ff50..$ff58] of Word = (keyHome, keyLeft, keyUp, keyRight, - keyDown, keyPrior, keyNext, keyEnd, keyBegin); - Table_ff6X: array[$ff60..$ff6b] of Word = (keySelect, keyPrintScreen, - keyExecute, keyInsert, keyNIL, keyUndo, keyRedo, keyMenu, keyFind, - keyCancel, keyHelp, keyBreak); - Table_ff9X: array[$ff91..$ff9f] of Word = (keyPF1, keyPF2, keyPF3, keyPF4, - keyP7, keyP4, keyP8, keyP6, keyP2, keyP9, keyP3, keyP1, keyP5, keyP0, - keyPDecimal); - Table_ffeX: array[$ffe1..$ffee] of Word = (keyShiftL, keyShiftR, keyCtrlL, - keyCtrlR, keyCapsLock, keyShiftLock, keyMetaL, keyMetaR, keyAltL, keyAltR, - keySuperL, keySuperR, keyHyperL, keyHyperR); -begin - case KeySym of - 0..Ord('a')-1, Ord('z')+1..$bf, $f7: - Result := KeySym; - Ord('a')..Ord('z'), $c0..$f6, $f8..$ff: - Result := KeySym - 32; - $20a0..$20ac: Result := Table_20aX[KeySym]; - $fe20: Result := keyTab; - $fe50..$fe60: Result := Table_feXX[KeySym]; - $ff08: Result := keyBackspace; - $ff09: Result := keyTab; - $ff0a: Result := keyLinefeed; - $ff0b: Result := keyClear; - $ff0d: Result := keyReturn; - $ff13: Result := keyPause; - $ff14: Result := keyScrollLock; - $ff15: Result := keySysRq; - $ff1b: Result := keyEscape; - $ff50..$ff58: Result := Table_ff5X[KeySym]; - $ff60..$ff6b: Result := Table_ff6X[KeySym]; - $ff7e: Result := keyModeSwitch; - $ff7f: Result := keyNumLock; - $ff80: Result := keyPSpace; - $ff89: Result := keyPTab; - $ff8d: Result := keyPEnter; - $ff91..$ff9f: Result := Table_ff9X[KeySym]; - $ffaa: Result := keyPAsterisk; - $ffab: Result := keyPPlus; - $ffac: Result := keyPSeparator; - $ffad: Result := keyPMinus; - $ffae: Result := keyPDecimal; - $ffaf: Result := keyPSlash; - $ffb0..$ffb9: Result := keyP0 + KeySym - $ffb0; - $ffbd: Result := keyPEqual; - $ffbe..$ffe0: Result := keyF1 + KeySym - $ffbe; - $ffe1..$ffee: Result := Table_ffeX[KeySym]; - $ffff: Result := keyDelete; - else - Result := keyNIL; - end; -{$IFDEF Debug} - if Result = keyNIL then - WriteLn('fpGFX/X11: Unknown KeySym: $', IntToHex(KeySym, 4)); -{$ENDIF} -end; - -function TfpgApplicationImpl.StartComposing(const Event: TXEvent): TKeySym; -begin - SetLength(FComposeBuffer, - XLookupString(@Event, @FComposeBuffer[1], - SizeOf(FComposeBuffer) - 1, @Result, @FComposeStatus)); -end; - -constructor TfpgApplicationImpl.Create(const aparams: string); -var - wa: TXWindowAttributes; -begin - FIsInitialized := False; - FDisplay := XOpenDisplay(PChar(aparams)); - - if FDisplay = nil then - Exit; //==> - - DefaultScreen := XDefaultScreen(Display); - RootWindow := XRootWindow(FDisplay, DefaultScreen); - DefaultBackground := XBlackPixel(FDisplay, DefaultScreen); - DefaultForeground := XWhitePixel(FDisplay, DefaultScreen); - - DefaultVisual := XDefaultVisual(FDisplay, DefaultScreen); - DisplayDepth := XDefaultDepth(FDisplay, DefaultScreen); - - //Writeln('display depth: ',DisplayDepth); - DefaultColorMap := XDefaultColorMap(FDisplay, DefaultScreen); - - // Initialize atoms - xia_clipboard := XInternAtom(FDisplay, 'CLIPBOARD', longbool(0)); - xia_targets := XInternAtom(FDisplay, 'TARGETS', longbool(0)); - xia_motif_wm_hints := XInternAtom(FDisplay, '_MOTIF_WM_HINTS', longbool(0)); - xia_wm_protocols := XInternAtom(FDisplay, 'WM_PROTOCOLS', longbool(0)); - xia_wm_delete_window := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', longbool(0)); - xia_wm_state := XInternAtom(FDisplay, '_NET_WM_STATE', longbool(0)); - xia_wm_state_modal := XInternAtom(FDisplay, '_NET_WM_STATE_MODAL', longbool(0)); - - // for correct keyboard handling - InputMethod := XOpenIM(FDisplay, nil, nil, nil); - if InputMethod = nil then - Exit; - - InputContext := XCreateIC(InputMethod, [XNInputStyle, XIMPreeditNothing or XIMStatusNothing, 0]); - if InputContext = nil then - Exit; - - FIsInitialized := True; - xapplication := TfpgApplication(self); -end; - -destructor TfpgApplicationImpl.Destroy; -begin - XCloseDisplay(FDisplay); - inherited Destroy; -end; - -function TfpgApplicationImpl.DoMessagesPending: boolean; -begin - Result := (XPending(display) > 0); -end; - -function GetParentWindow(wh: TfpgWinHandle; var pw, rw: TfpgWinHandle): boolean; -var - rootw: TfpgWinHandle; - parentw: TfpgWinHandle; - childs: ^TfpgWinHandle; - cnum: longword; -begin - childs := nil; - if XQueryTree(xapplication.display, wh, @rootw, @parentw, @childs, @cnum) <> 0 then - begin - pw := parentw; - rw := rootw; - Result := True; - end - else - Result := False; - if childs <> nil then - XFree(childs); -end; - -function GetDecorationWindow(wh: TfpgWinHandle): TfpgWinHandle; -var - lpw: TfpgWinHandle; - pw: TfpgWinHandle; - rw: TfpgWinHandle; - bok: boolean; -begin - pw := wh; - repeat - lpw := pw; - bok := GetParentWindow(lpw, pw, rw); - until (not bok) or (pw = rw); - if bok then - Result := lpw - else - Result := 0; -end; - -function X11keycodeToScanCode(akeycode: word): word; -begin - case akeycode and $ff of - $09..$5B: Result := akeycode - 8; - $6C: Result := $11C; // numpad enter - $6D: Result := $11D; // right ctrl - $70: Result := $135; // numpad / - $62: Result := $148; // up arrow - $64: Result := $14B; - $66: Result := $14D; - $68: Result := $150; // down arrow - $6A: Result := $152; - $61: Result := $147; - $63: Result := $149; - $6B: Result := $153; - $67: Result := $14F; - $69: Result := $151; - $71: Result := $138; - else - Result := akeycode; - end; -end; - -procedure TfpgApplicationImpl.DoWaitWindowMessage(atimeoutms: integer); -var - ev: TXEvent; - NewEvent: TXevent; - n: integer; - i: integer; - r: integer; - i2: integer; - ks: integer; - uc: word; - a: array[1..16] of char; - ss: integer; - sr: integer; - p: PChar; - blockmsg: boolean; - b: boolean; - w: TfpgWindowImpl; - ew: TfpgWindowImpl; - kwg: TfpgWidget; - wh: TfpgWinHandle; - wa: TXWindowAttributes; - px: integer; - py: integer; - mcode: integer; - msgp: TfpgMessageParams; - rfds: TFDSet; - xfd: integer; - KeySym: TKeySym; -begin - xfd := XConnectionNumber(display); - - repeat - if (atimeoutms >= 0) and (XPending(display) <= 0) then - begin - // waiting some event for the given timeout - - // this Select handles only the first 256 file descriptors - // poll would be better but FPC has no official poll interface (if I'm right) - if atimeoutms > 0 then - begin - fpFD_ZERO(rfds); - fpFD_SET(xfd, rfds); - r := fpSelect(xfd + 1, @rfds, nil, nil, atimeoutms); - end - else - r := 0; - - if r <= 0 then - Exit; // no event received. - end; - XNextEvent(display, @ev); - until (not XFilterEvent(@ev, 0)); - - blockmsg := False; - fillchar(msgp, sizeof(msgp), 0); - - - // According to a comment in X.h, the valid event types start with 2! - if ev._type < 2 then - exit; - -// WriteLn('Event ',GetXEventName(ev._type),': ', ev._type,' window: ', ev.xany.window); - - case ev._type of - X.KeyPress, - X.KeyRelease: - begin - KeySym := StartComposing(ev); - msgp.keyboard.keycode := KeySymToKeycode(KeySym); - msgp.keyboard.shiftstate := ConvertShiftState(ev.xkey.state); - - kwg := FindKeyboardFocus; - if kwg <> nil then - w := kwg - else - w := FindWindowByHandle(ev.xkey.window); - - //Writeln('XKey event(',ev._type,'):', - //IntToHex(ev.xkey.keycode,4),' (',ev.xkey.keycode,'), shift=',IntToHex(ev.xkey.state,4)); - - if ev._type = X.KeyPress then - begin - fpgPostMessage(nil, w, FPGM_KEYPRESS, msgp); - - //Writeln('scancode: ',IntToHex(X11keycodeToScanCode(ev.xkey.keycode),4) - // ,' (',X11keycodeToScanCode(ev.xkey.keycode),')'); - - // Revision 203 used scancodes and XmbLookupString compared to XLookupString. - // Maybe in the future we can switch to XmbLookupString again. - if (ev.xkey.state and (ControlMask or Mod1Mask)) = 0 then - begin - for i := 1 to Length(FComposeBuffer) do - begin - msgp.keyboard.keychar := FComposeBuffer[i]; - fpgPostMessage(nil, w, FPGM_KEYCHAR, msgp); - end; - end; - end { if } - else if ev._type = X.KeyRelease then - fpgPostMessage(nil, w, FPGM_KEYRELEASE, msgp); - end; - - X.ButtonPress, - X.ButtonRelease: - begin - msgp.mouse.x := ev.xbutton.x; - msgp.mouse.y := ev.xbutton.y; - msgp.mouse.Buttons := ev.xbutton.button; - msgp.mouse.shiftstate := ConvertShiftState(ev.xbutton.state); - - w := FindWindowByHandle(ev.xbutton.window); - - if fpgTopModalForm <> nil then - begin - // This is ugly!!!!!!!!!!!!!!! - ew := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w))); - if (ew <> nil) and (fpgTopModalForm <> ew) then - blockmsg := true; - end; - - if not blockmsg then - begin - if (ev.xbutton.button >= 4) and (ev.xbutton.button <= 7) then // mouse wheel - begin - // generate scroll events: - if ev._type = X.ButtonPress then - begin - if ev.xbutton.button = Button4 then - i := -1 - else - i := 1; - - // Check for other mouse wheel messages in the queue - while XCheckTypedWindowEvent(display, ev.xany.window, X.ButtonPress, @NewEvent) do - begin - if NewEvent.xbutton.Button = 4 then - Dec(i) - else if NewEvent.xbutton.Button = 5 then - Inc(i) - else - begin - XPutBackEvent(display, @NewEvent); - break; - end; - end; - - msgp.mouse.delta := i; - fpgPostMessage(nil, w, FPGM_SCROLL, msgp); - end; - end - else - begin - if ev._type = X.ButtonRelease then - mcode := FPGM_MOUSEUP - else - mcode := FPGM_MOUSEDOWN; - fpgPostMessage(nil, w, mcode, msgp); - end; { if/else } - end; { if not blocking } - end; - - X.Expose: - begin - repeat - // - until not XCheckTypedWindowEvent(display, ev.xany.window, X.Expose, @ev); - if ev.xexpose.count = 0 then - begin - fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_PAINT); - end; - end; - - X.MotionNotify: - begin - repeat - // - until not XCheckTypedWindowEvent(display, ev.xbutton.window, X.MotionNotify, @ev); - - if not blockmsg then - begin - msgp.mouse.x := ev.xmotion.x; - msgp.mouse.y := ev.xmotion.y; - msgp.mouse.Buttons := (ev.xmotion.state and $FF00) shr 8; - msgp.mouse.shiftstate := ConvertShiftState(ev.xmotion.state); - fpgPostMessage(nil, FindWindowByHandle(ev.xbutton.window), FPGM_MOUSEMOVE, msgp); - end; - end; - - // message blockings for modal windows - X.ClientMessage: - if not blockmsg then - fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_CLOSE); - - - X.ConfigureNotify: - begin - repeat - // - until not XCheckTypedWindowEvent(display, ev.xany.window, ConfigureNotify, @ev); - - msgp.rect.Left := ev.xconfigure.x; - msgp.rect.Top := ev.xconfigure.y; - msgp.rect.Width := ev.xconfigure.Width; - msgp.rect.Height := ev.xconfigure.Height; - - w := FindWindowByHandle(ev.xconfigure.window); - if w <> nil then - begin - if w.FWindowType <> wtChild then - begin - wh := GetDecorationWindow(ev.xconfigure.window); - if wh > 0 then - begin - XGetWindowAttributes(display, wh, @wa); - msgp.rect.Left := wa.x; - msgp.rect.Top := wa.y; - end; - end; - - if (w.FWidth <> msgp.rect.Width) or (w.FHeight <> msgp.rect.Height) then - fpgPostMessage(nil, w, FPGM_RESIZE, msgp); - - if (w.FLeft <> msgp.rect.Left) or (w.FTop <> msgp.rect.Top) then - fpgPostMessage(nil, w, FPGM_MOVE, msgp); - end; - end; - -{ - X.SelectionNotify: - begin - ProcessSelection(ev); - end; - - X.SelectionRequest: - begin - ProcessSelectionRequest(ev); - end; -} - - X.FocusIn: - fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_ACTIVATE); - - X.FocusOut: - fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_DEACTIVATE); - - X.EnterNotify: - fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_MOUSEENTER); - - X.LeaveNotify: - fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_MOUSEEXIT); - - { We handle these two event manually in the TfpgForm class } - X.MapNotify, - X.UnmapNotify: - begin - //Writeln('UnmapNotify'); - end; - - { We handle this event manually as well. } - X.DestroyNotify: - begin - //Writeln('DestroyNotify'); - //fpgPostMessage(nil, FindWindowByHandle(ev.xany.window), FPGM_CLOSE); - end; - - X.GraphicsExpose, - X.NoExpose: - begin - // writeln('got a GraphicsExpose or NoExpose event'); - { If this application calls XCopyArea or XCopyPlane - and the graphics_exposures member of the GC is - True and the source is a window, these events may - be generated; handle GraphicsExpose like Expose } - end; - - X.ReparentNotify: - begin - // We are not interrested in this event - end; - else - {$Note This needs attention. We still have two events slipping by.} - WriteLn('fpGFX/X11: Unhandled X11 event received: ', GetXEventName(ev._type)); - end; -end; - -procedure TfpgApplicationImpl.DoFlush; -begin - XFlush(FDisplay); -end; - -function TfpgApplicationImpl.GetScreenWidth: TfpgCoord; -var - wa: TXWindowAttributes; -begin - XGetWindowAttributes(FDisplay, RootWindow, @wa); - Result := wa.Width; -end; - -function TfpgApplicationImpl.GetScreenHeight: TfpgCoord; -var - wa: TXWindowAttributes; -begin - XGetWindowAttributes(FDisplay, RootWindow, @wa); - Result := wa.Height; -end; - -{ TfpgWindowImpl } - -procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase); -var - pwh: TfpgWinHandle; - wh: TfpgWinHandle; - attr: TXSetWindowAttributes; - mask: longword; - bcolor: longword; - hints: TXSizeHints; -begin - if FWinHandle > 0 then - Exit; //==> - - if aparent <> nil then - pwh := TfpgWindowImpl(AParent).WinHandle - else - pwh := xapplication.RootWindow; - - FillChar(attr, sizeof(attr), 0); - mask := 0; - if FWindowType in [wtPopup] then - begin - attr.Override_Redirect := longbool(1); - mask := CWOverrideRedirect; - end; - - AdjustWindowStyle; - - wh := XCreateWindow(xapplication.Display, pwh, - FLeft, FTop, FWidth, FHeight, 0, - CopyFromParent, - InputOutput, - xapplication.DefaultVisual, - mask, @attr); - - FWinHandle := wh; - hints.flags := 0; - - if not (waAutoPos in FWindowAttributes) then - hints.flags := hints.flags or PPosition; - - if waScreenCenterPos in FWindowAttributes then - begin - hints.flags := hints.flags or PPosition; - - FLeft := (xapplication.ScreenWidth - FWidth) div 2; - FTop := (xapplication.ScreenHeight - FHeight) div 2; - DoMoveWindow(FLeft, FTop); - end; - - if (FWindowType <> wtChild) and (waSizeable in FWindowAttributes) then - begin - hints.flags := hints.flags or PMinSize; - hints.min_width := FMinWidth; - hints.min_height := FMinHeight; - end - else - begin - hints.flags := hints.flags or PMinSize or PMaxSize; - hints.min_width := FWidth; - hints.min_height := FHeight; - hints.max_width := FWidth; - hints.max_height := FHeight; - end; - - XSetWMNormalHints(xapplication.display, FWinHandle, @hints); - - if FWindowType <> wtChild then - XSetWMProtocols(xapplication.Display, FWinHandle, @(xapplication.xia_wm_delete_window), - 1);// send close event instead of quitting the whole application... - - // for modal windows, this is necessary - if (FWindowType = wtModalForm) and (AParent <> nil) then - XSetTransientForHint(xapplication.display, FWinHandle, TfpgWindowImpl(AParent).WinHandle); - - XSelectInput(xapplication.Display, wh, KeyPressMask or KeyReleaseMask or - ButtonPressMask or ButtonReleaseMask or - EnterWindowMask or LeaveWindowMask or - ButtonMotionMask or PointerMotionMask or - ExposureMask or FocusChangeMask or - StructureNotifyMask); - - SetWindowParameters; - XMapWindow(xapplication.Display, wh); - AddWindowLookup(self); -end; - -procedure TfpgWindowImpl.DoReleaseWindowHandle; -begin - if FWinHandle <= 0 then - Exit; - - RemoveWindowLookup(self); - XDestroyWindow(xapplication.Display, FWinHandle); - - FWinHandle := 0; -end; - -function TfpgWindowImpl.HandleIsValid: boolean; -begin - Result := (FWinHandle > 0); -end; - -procedure TfpgWindowImpl.DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); -begin - if FWinHandle > 0 then - XMoveWindow(xapplication.display, FWinHandle, x, y); -end; - -function TfpgWindowImpl.DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; -var - dx: integer; - dy: integer; - cw : TfpgWinHandle; -begin -// if not HandleIsValid then -// Exit; //==> - - XTranslateCoordinates(xapplication.display, TfpgWindowImpl(ASource).WinHandle, - XDefaultRootWindow(xapplication.display), AScreenPos.X, AScreenPos.Y, @dx, @dy, @cw); - - Result.X := dx; - Result.Y := dy; -end; - -procedure TfpgWindowImpl.DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); -var - w: longword; - h: longword; -begin - if awidth > 1 then - w := awidth - else - w := 1; - if aheight > 1 then - h := aheight - else - h := 1; - - if FWinHandle > 0 then - XMoveResizeWindow(xapplication.display, FWinHandle, aleft, atop, w, h); -end; - -procedure TfpgWindowImpl.DoSetWindowTitle(const atitle: string); -var - //s: string; - //p: PByte; - netlayer: TNETWindowLayer; -begin - if FWinHandle <= 0 then - Exit; - - //s := atitle; - - //if length(s) > 0 then - //p := @s[1] - //else - //p := nil; - - netlayer := TNETWindowLayer.Create(xapplication.display); - try - netlayer.WindowSetName(FWinHandle, PChar(ATitle)); - finally - netlayer.Free; - end; - -// XChangeProperty(xapplication.display, FWinHandle, 39, 31, 8, 0, p, length(s)); -// XChangeProperty(xapplication.display, FWinHandle, 37, 31, 8, 0, p, length(s)); -end; - -constructor TfpgWindowImpl.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FWinHandle := 0; -end; - -procedure TfpgWindowImpl.CaptureMouse; -begin - XGrabPointer(xapplication.Display, FWinHandle, - True, - ButtonPressMask or ButtonReleaseMask or ButtonMotionMask or PointerMotionMask, - GrabModeAsync, - GrabModeAsync, - None, - 0, - CurrentTime - ); -end; - -procedure TfpgWindowImpl.ReleaseMouse; -begin - XUngrabPointer(xapplication.display, CurrentTime); -end; - -{ TfpgFontResourceImpl } - -constructor TfpgFontResourceImpl.Create(const afontdesc: string); -begin - FFontData := XftFontOpenName(xapplication.display, xapplication.DefaultScreen, PChar(afontdesc)); -end; - -destructor TfpgFontResourceImpl.Destroy; -begin - if HandleIsValid then - XftFontClose(xapplication.Display, FFontData); - - inherited; -end; - -function TfpgFontResourceImpl.HandleIsValid: boolean; -begin - Result := (FFontData <> nil); -end; - -function TfpgFontResourceImpl.GetAscent: integer; -begin - Result := FFontData^.ascent; -end; - -function TfpgFontResourceImpl.GetDescent: integer; -begin - Result := FFontData^.descent; -end; - -function TfpgFontResourceImpl.GetHeight: integer; -begin - // Do NOT use FFontData^.height as it isn't as accurate - Result := GetAscent + GetDescent; -end; - -function TfpgFontResourceImpl.GetTextWidth(const txt: string): integer; -var - extents: TXGlyphInfo; -begin - if length(txt) < 1 then - begin - Result := 0; - Exit; - end; - XftTextExtentsUTF8(xapplication.display, FFontData, PChar(txt), Length(txt), extents); - Result := extents.xOff; -end; - -{ TfpgCanvasImpl } - -constructor TfpgCanvasImpl.Create; -begin - inherited; - FDrawing := False; - FDrawWindow := nil; - - FBufferPixmap := 0; - FDrawHandle := 0; - Fgc := nil; - FXftDraw := nil; - FClipRegion := nil; -end; - -destructor TfpgCanvasImpl.Destroy; -begin - if FDrawing then - DoEndDraw; - inherited Destroy; -end; - -procedure TfpgCanvasImpl.DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); -var - x: integer; - y: integer; - rw: TXID; - d: TXID; - w: longword; - h: longword; - bw: longword; - pmw: longword; - pmh: longword; - GcValues: TXGcValues; -begin - XGetGeometry(xapplication.display, TfpgWindowImpl(awin).FWinHandle, @rw, @x, @y, @w, @h, @bw, @d); - - if FDrawing and buffered and (FBufferPixmap > 0) then - if FBufferPixmap > 0 then - begin - // check if the dimensions are ok - XGetGeometry(xapplication.display, FBufferPixmap, @rw, @x, @y, @pmw, @pmh, @bw, @d); - if (pmw <> w) or (pmh <> h) then - DoEndDraw; - end; - - if not FDrawing then - begin - FDrawWindow := TfpgWindowImpl(awin); - - if buffered then - begin - FBufferPixmap := XCreatePixmap(xapplication.display, FDrawWindow.FWinHandle, w, h, xapplication.DisplayDepth); - FDrawHandle := FBufferPixmap; - end - else - begin - FBufferPixmap := 0; - FDrawHandle := FDrawWindow.FWinHandle; - end; - - Fgc := XCreateGc(xapplication.display, FDrawHandle, 0, @GcValues); - - FXftDraw := XftDrawCreate(xapplication.display, FDrawHandle, - XDefaultVisual(xapplication.display, xapplication.DefaultScreen), - XDefaultColormap(xapplication.display, xapplication.DefaultScreen)); - - FClipRegion := XCreateRegion; - end; - - FDrawing := True; -end; - -procedure TfpgCanvasImpl.DoPutBufferToScreen(x, y, w, h: TfpgCoord); -var - cgc: TfpgGContext; - GcValues: TXGcValues; -begin - if FBufferPixmap > 0 then - begin - cgc := XCreateGc(xapplication.display, FBufferPixmap, 0, @GcValues); - XCopyArea(xapplication.Display, FBufferPixmap, FDrawWindow.FWinHandle, cgc, x, y, w, h, x, y); - XFreeGc(xapplication.display, cgc); - end; -end; - -procedure TfpgCanvasImpl.DoEndDraw; -begin - if FDrawing then - begin - XDestroyRegion(FClipRegion); - XftDrawDestroy(FXftDraw); - XFreeGc(xapplication.display, Fgc); - - if FBufferPixmap > 0 then - XFreePixmap(xapplication.Display, FBufferPixmap); - FBufferPixmap := 0; - - FDrawing := False; - FDrawWindow := nil; - end; -end; - -function TfpgCanvasImpl.GetPixel(X, Y: integer): TfpgColor; -var - Image: PXImage; - Pixel: Cardinal; - x_Color: TXColor; -begin - Result := 0; - - Image := XGetImage(xapplication.display, FDrawHandle, X, Y, 1, 1, $FFFFFFFF, ZPixmap); - if Image = nil then - raise Exception.Create('fpGFX/X11: Invalid XImage'); - - try - Pixel := XGetPixel(Image, 0, 0); - x_Color.pixel := Pixel; - - XQueryColor(xapplication.display, xapplication.DefaultColorMap, @x_Color); - Result := TfpgColor(((x_Color.red and $00FF) shl 16) or - ((x_Color.green and $00FF) shl 8) or - (x_Color.blue and $00FF)); - finally - XDestroyImage(Image); - end; -end; - -procedure TfpgCanvasImpl.SetPixel(X, Y: integer; const AValue: TfpgColor); -var - oldColor: TfpgColor; -begin - oldColor := Color; - SetColor(AValue); - DrawLine(X, Y, X+1, Y+1); - SetColor(oldColor); - {$Note We must still implement DrawPoint} -end; - -procedure TfpgCanvasImpl.DoSetFontRes(fntres: TfpgFontResourceBase); -begin - if fntres = nil then - Exit; //==> - FCurFontRes := TfpgFontResourceImpl(fntres); -end; - -procedure TfpgCanvasImpl.DoSetTextColor(cl: TfpgColor); -begin - SetXftColor(cl, FColorTextXft); -end; - -procedure TfpgCanvasImpl.DoSetColor(cl: TfpgColor); -begin - XSetForeGround(xapplication.display, Fgc, fpgColorToX(cl)); -end; - -procedure TfpgCanvasImpl.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); -//const -// DotDashes: array[0..1] of Char = #1#1; -// DotDashes: array[0..1] of Char = #4#2; - { It was #1#1 which gives 1 pixel dots. Now it gives a 4 pixel line and a - 2 pixel space. } -var - ls: integer; - DotDashes: array[0..6] of Char; - len: integer; -begin - {$Note Extend this and the GDI code some more to support more Line Styles} - // This design can be improved on. It smells! - len := 0; - case AStyle of - lsDot: - begin - ls := LineOnOffDash; - len := 2; - DotDashes[0] := Char(#1); - DotDashes[1] := Char(#1); - end; - lsDash: - begin - ls := LineOnOffDash; - len := 2; - DotDashes[0] := Char(#4); - DotDashes[1] := Char(#2); - end; - lsSolid: - ls := LineSolid; - else - ls := LineSolid; - end; - XSetLineAttributes(xapplication.display, Fgc, awidth, ls, CapButt, JoinMiter); - if ls = LineOnOffDash then - XSetDashes(xapplication.display, Fgc, 0, DotDashes, len); -end; - -procedure TfpgCanvasImpl.DoDrawString(x, y: TfpgCoord; const txt: string); -begin - if Length(txt) < 1 then - Exit; //==> - - XftDrawStringUTF8(FXftDraw, FColorTextXft, FCurFontRes.Handle, x, - y + FCurFontRes.GetAscent, PChar(txt), Length(txt)); -end; - -procedure TfpgCanvasImpl.DoGetWinRect(var r: TfpgRect); -var - rw: TfpgWinHandle; - x: integer; - y: integer; - bw: longword; - d: longword; -begin - r.left := 0; - r.Top := 0; - XGetGeometry(xapplication.display, FDrawWindow.FWinHandle, @rw, @x, @y, - @(r.Width), @(r.Height), @bw, @d); -end; - -procedure TfpgCanvasImpl.DoFillRectangle(x, y, w, h: TfpgCoord); -begin - // Remember this for when we add Canvas.Pen support! - { Note: By default XFillRectangle doesn't paint the same size rectangle that - XDrawRectangle does - given the same coordinates! In this case we enlarge - the Width and Height to paint consistant rectangle sizes, even thought it - might repaint the same (only a few) pixels twice. } - XFillRectangle(xapplication.display, FDrawHandle, Fgc, x, y, w{+1}, h{+1}); -end; - -procedure TfpgCanvasImpl.DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); -begin - XSetForeGround(xapplication.display, Fgc, fpgColorToX(fpgColorToRGB(col))); - XSetFunction(xapplication.display, Fgc, GXxor); - XFillRectangle(xapplication.display, FDrawHandle, Fgc, x, y, w, h); - XSetForeGround(xapplication.display, Fgc, 0); - XSetFunction(xapplication.display, Fgc, GXcopy); -end; - -procedure TfpgCanvasImpl.DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); -var - pts: array[1..3] of TXPoint; -begin - pts[1].x := x1; - pts[1].y := y1; - pts[2].x := x2; - pts[2].y := y2; - pts[3].x := x3; - pts[3].y := y3; - - XFillPolygon(xapplication.display, FDrawHandle, Fgc, @pts, 3, 0, 0); -end; - -procedure TfpgCanvasImpl.DoDrawRectangle(x, y, w, h: TfpgCoord); -begin - XDrawRectangle(xapplication.display, FDrawHandle, Fgc, x, y, w-1, h-1); -end; - -procedure TfpgCanvasImpl.DoDrawLine(x1, y1, x2, y2: TfpgCoord); -begin - XDrawLine(xapplication.display, FDrawHandle, Fgc, x1, y1, x2, y2); -end; - -procedure TfpgCanvasImpl.DoSetClipRect(const rect: TfpgRect); -var - r: TXRectangle; - rg: TRegion; -begin - r.x := rect.left; - r.y := rect.top; - r.Width := rect.Width; - r.Height := rect.Height; - - rg := XCreateRegion; - - XUnionRectWithRegion(@r, rg, FClipRegion); - XSetRegion(xapplication.display, Fgc, FClipRegion); - XftDrawSetClip(FXftDraw, FClipRegion); - - FClipRect := rect; - FClipRectSet := True; - XDestroyRegion(rg); -end; - -function TfpgCanvasImpl.DoGetClipRect: TfpgRect; -begin - Result := FClipRect; -end; - -procedure TfpgCanvasImpl.DoAddClipRect(const rect: TfpgRect); -var - r: TXRectangle; - rg: TRegion; -begin - r.x := rect.left; - r.y := rect.top; - r.Width := rect.Width; - r.Height := rect.Height; - - rg := XCreateRegion; - XUnionRectWithRegion(@r, rg, rg); - XIntersectRegion(FClipRegion, rg, FClipRegion); - XSetRegion(xapplication.display, Fgc, FClipRegion); - - FClipRect := Rect; - FClipRectSet := True; - - XftDrawSetClip(FXftDraw, FClipRegion); - XDestroyRegion(rg); -end; - -procedure TfpgCanvasImpl.DoClearClipRect; -var - r: TfpgRect; -begin - DoGetWinRect(r); - DoSetClipRect(r); - FClipRectSet := False; -end; - -procedure TfpgCanvasImpl.DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); -var - msk: TPixmap; - gc2: Tgc; - drawgc: Tgc; - GcValues: TXGcValues; -begin - if img = nil then - Exit; //==> - - if img.Masked then - begin - // rendering the mask - msk := XCreatePixmap(xapplication.display, XDefaultRootWindow(xapplication.display), w, h, 1); - GcValues.foreground := 1; - GcValues.background := 0; - - // clear mask - gc2 := XCreateGc(xapplication.display, msk, GCForeground or GCBackground, @GcValues); - XSetForeground(xapplication.display, gc2, 0); - XFillRectangle(xapplication.display, msk, gc2, 0, 0, w, h); - - XSetForeground(xapplication.display, gc2, 1); - XPutImage(xapplication.display, msk, gc2, TfpgImageImpl(img).XImageMask, xi, yi, 0, 0, w, h); - - drawgc := XCreateGc(xapplication.display, FDrawHandle, 0, @GcValues); - XSetClipMask(xapplication.display, drawgc, msk); - XSetClipOrigin(xapplication.display, drawgc, x, y); - - XPutImage(xapplication.display, FDrawHandle, drawgc, TfpgImage(img).XImage, xi, yi, x, y, w, h); - XFreePixmap(xapplication.display, msk); - XFreeGc(xapplication.display, drawgc); - XFreeGc(xapplication.display, gc2); - end - else - XPutImage(xapplication.display, FDrawHandle, Fgc, TfpgImage(img).XImage, xi, yi, x, y, w, h); -end; - -{ TfpgImageImpl } - -constructor TfpgImageImpl.Create; -begin - inherited Create; -end; - -procedure TfpgImageImpl.DoFreeImage; -begin - // does nothing on X11 -end; - -procedure TfpgImageImpl.DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); -begin - FMasked := False; - - with FXimg do - begin - Width := awidth; - Height := aheight; - xoffset := 0; - obdata := #0; - byte_order := LSBFirst; - bitmap_bit_order := MSBFirst; - bitmap_pad := 32; - bytes_per_line := 0; - - if acolordepth = 1 then - begin - format := XYBitmap; - bitmap_unit := 8; - depth := 1; - bits_per_pixel := 1; - red_mask := 1; - green_mask := 0; - blue_mask := 0; - end - else - begin - format := ZPixmap; - bitmap_unit := 32; - - // only truecolor 24/32 displays supported now, otherwise color conversion required! - // this must be match for the display !!! - depth := xapplication.DisplayDepth; // acolordepth; - bits_per_pixel := 32; - - // Shouldn't we rather get this from XDefaultVisualOfScreen(). PVisual? - red_mask := $000000FF; - green_mask := $0000FF00; - blue_mask := $00FF0000; - end; - - Data := aimgdata; - end; - - XInitImage(@FXimg); -end; - -procedure TfpgImageImpl.DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); -begin - FMasked := True; - - with FXimgMask do - begin - Width := awidth; - Height := aheight; - xoffset := 0; - format := XYBitmap; - byte_order := LSBFirst; - bitmap_unit := 8; - bitmap_bit_order := MSBFirst; - bitmap_pad := 32; - depth := 1; - bytes_per_line := 0; - bits_per_pixel := 1; - - red_mask := 1; - green_mask := 0; - blue_mask := 0; - - obdata := #0; - - Data := aimgdata; - end; - - XInitImage(@FXimgMask); -end; - -function TfpgImageImpl.XImage: PXImage; -begin - Result := @FXimg; -end; - -function TfpgImageImpl.XImageMask: PXImage; -begin - Result := @FXimgMask; -end; - -initialization - xapplication := nil; - -end. - diff --git a/prototypes/fpgui2/source/core/x11/x11_keyconv.pas b/prototypes/fpgui2/source/core/x11/x11_keyconv.pas deleted file mode 100644 index 297ff50b..00000000 --- a/prototypes/fpgui2/source/core/x11/x11_keyconv.pas +++ /dev/null @@ -1,319 +0,0 @@ -unit x11_keyconv; - -{$mode objfpc}{$H+} - -interface - -// - -// This conversion was taken from the OppenOffice 1.0.1 source code. -procedure KeySymToUnicode(ks : longword; res : PWord); - -implementation - -type - unichar = word; - -const - -// Latin-1 Byte 3 = $00 - keymap00 : array[32..255] of unichar = ( - $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, - $0028, $0029, $002a, $002b, $002c, $002d, $002e, $002f, - $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, - $0038, $0039, $003a, $003b, $003c, $003d, $003e, $003f, - $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, - $0048, $0049, $004a, $004b, $004c, $004d, $004e, $004f, - $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, - $0058, $0059, $005a, $005b, $005c, $005d, $005e, $005f, - $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, - $0068, $0069, $006a, $006b, $006c, $006d, $006e, $006f, - $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, - $0078, $0079, $007a, $007b, $007c, $007d, $007e, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $00a0, $00a1, $00a2, $00a3, $00a4, $00a5, $00a6, $00a7, - $00a8, $00a9, $00aa, $00ab, $00ac, $00ad, $00ae, $00af, - $00b0, $00b1, $00b2, $00b3, $00b4, $00b5, $00b6, $00b7, - $00b8, $00b9, $00ba, $00bb, $00bc, $00bd, $00be, $00bf, - $00c0, $00c1, $00c2, $00c3, $00c4, $00c5, $00c6, $00c7, - $00c8, $00c9, $00ca, $00cb, $00cc, $00cd, $00ce, $00cf, - $00d0, $00d1, $00d2, $00d3, $00d4, $00d5, $00d6, $00d7, - $00d8, $00d9, $00da, $00db, $00dc, $00dd, $00de, $00df, - $00e0, $00e1, $00e2, $00e3, $00e4, $00e5, $00e6, $00e7, - $00e8, $00e9, $00ea, $00eb, $00ec, $00ed, $00ee, $00ef, - $00f0, $00f1, $00f2, $00f3, $00f4, $00f5, $00f6, $00f7, - $00f8, $00f9, $00fa, $00fb, $00fc, $00fd, $00fe, $00ff - ); - -// Latin-2 Byte 3 = $01 - keymap01 : array[161..255] of unichar = ( - $0104, $02d8, $0141, $0000, $013d, $015a, $0000, $0000, - $0160, $015e, $0164, $0179, $0000, $017d, $017b, $0000, - $0105, $02db, $0142, $0000, $013e, $015b, $02c7, $0000, - $0161, $015f, $0165, $017a, $02dd, $017e, $017c, $0154, - $0000, $0000, $0102, $0000, $0139, $0106, $0000, $010c, - $0000, $0118, $0000, $011a, $0000, $0000, $010e, $0110, - $0143, $0147, $0000, $0000, $0150, $0000, $0000, $0158, - $016e, $0000, $0170, $0000, $0000, $0162, $0000, $0155, - $0000, $0000, $0103, $0000, $013a, $0107, $0000, $010d, - $0000, $0119, $0000, $011b, $0000, $0000, $010f, $0111, - $0144, $0148, $0000, $0000, $0151, $0000, $0000, $0159, - $016f, $0000, $0171, $0000, $0000, $0163, $02d9 ); - -// Latin-3 Byte 3 = $02 - keymap02 : array[161..254] of unichar = ( - $0126, $0000, $0000, $0000, $0000, $0124, $0000, $0000, - $0130, $0000, $011e, $0134, $0000, $0000, $0000, $0000, - $0127, $0000, $0000, $0000, $0000, $0125, $0000, $0000, - $0131, $0000, $011f, $0135, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $010a, $0108, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0120, $0000, $0000, $011c, - $0000, $0000, $0000, $0000, $016c, $015c, $0000, $0000, - $0000, $0000, $0000, $0000, $010b, $0109, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0121, $0000, $0000, $011d, - $0000, $0000, $0000, $0000, $016d, $015d ); - -// Latin-4 Byte 3 = $03 - keymap03 : array[162..254] of unichar = ( - $0138, $0156, $0000, $0128, $013b, $0000, $0000, $0000, - $0112, $0122, $0166, $0000, $0000, $0000, $0000, $0000, - $0000, $0157, $0000, $0129, $013c, $0000, $0000, $0000, - $0113, $0123, $0167, $014a, $0000, $014b, $0100, $0000, - $0000, $0000, $0000, $0000, $0000, $012e, $0000, $0000, - $0000, $0000, $0116, $0000, $0000, $012a, $0000, $0145, - $014c, $0136, $0000, $0000, $0000, $0000, $0000, $0172, - $0000, $0000, $0000, $0168, $016a, $0000, $0101, $0000, - $0000, $0000, $0000, $0000, $0000, $012f, $0000, $0000, - $0000, $0000, $0117, $0000, $0000, $012b, $0000, $0146, - $014d, $0137, $0000, $0000, $0000, $0000, $0000, $0173, - $0000, $0000, $0000, $0169, $016b ); - -// Kana Byte 3 = $04 - keymap04 : array[126..223] of unichar = ( - $203e, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $3002, $300c, $300d, $3001, $30fb, - $30f2, $30a1, $30a3, $30a5, $30a7, $30a9, $30e3, $30e5, - $30e7, $30c3, $30fc, $30a2, $30a4, $30a6, $30a8, $30aa, - $30ab, $30ad, $30af, $30b1, $30b3, $30b5, $30b7, $30b9, - $30bb, $30bd, $30bf, $30c1, $30c4, $30c6, $30c8, $30ca, - $30cb, $30cc, $30cd, $30ce, $30cf, $30d2, $30d5, $30d8, - $30db, $30de, $30df, $30e0, $30e1, $30e2, $30e4, $30e6, - $30e8, $30e9, $30ea, $30eb, $30ec, $30ed, $30ef, $30f3, - $309b, $309c ); - -// Arabic Byte 3 = $05 - keymap05 : array[172..242] of unichar = ( - $060c, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $061b, - $0000, $0000, $0000, $061f, $0000, $0621, $0622, $0623, - $0624, $0625, $0626, $0627, $0628, $0629, $062a, $062b, - $062c, $062d, $062e, $062f, $0630, $0631, $0632, $0633, - $0634, $0635, $0636, $0637, $0638, $0639, $063a, $0000, - $0000, $0000, $0000, $0000, $0640, $0641, $0642, $0643, - $0644, $0645, $0646, $0647, $0648, $0649, $064a, $064b, - $064c, $064d, $064e, $064f, $0650, $0651, $0652 ); - -// Cyrillic Byte 3 = $06 - keymap06 : array[161..255] of unichar = ( - $0452, $0453, $0451, $0454, $0455, $0456, $0457, $0458, - $0459, $045a, $045b, $045c, $0000, $045e, $045f, $2116, - $0402, $0403, $0401, $0404, $0405, $0406, $0407, $0408, - $0409, $040a, $040b, $040c, $0000, $040e, $040f, $044e, - $0430, $0431, $0446, $0434, $0435, $0444, $0433, $0445, - $0438, $0439, $043a, $043b, $043c, $043d, $043e, $043f, - $044f, $0440, $0441, $0442, $0443, $0436, $0432, $044c, - $044b, $0437, $0448, $044d, $0449, $0447, $044a, $042e, - $0410, $0411, $0426, $0414, $0415, $0424, $0413, $0425, - $0418, $0419, $041a, $041b, $041c, $041d, $041e, $041f, - $042f, $0420, $0421, $0422, $0423, $0416, $0412, $042c, - $042b, $0417, $0428, $042d, $0429, $0427, $042a ); - -// Greek Byte 3 = $07 - keymap07 : array[161..249] of unichar = ( - $0386, $0388, $0389, $038a, $03aa, $0000, $038c, $038e, - $03ab, $0000, $038f, $0000, $0000, $0385, $2015, $0000, - $03ac, $03ad, $03ae, $03af, $03ca, $0390, $03cc, $03cd, - $03cb, $03b0, $03ce, $0000, $0000, $0000, $0000, $0000, - $0391, $0392, $0393, $0394, $0395, $0396, $0397, $0398, - $0399, $039a, $039b, $039c, $039d, $039e, $039f, $03a0, - $03a1, $03a3, $0000, $03a4, $03a5, $03a6, $03a7, $03a8, - $03a9, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $03b1, $03b2, $03b3, $03b4, $03b5, $03b6, $03b7, $03b8, - $03b9, $03ba, $03bb, $03bc, $03bd, $03be, $03bf, $03c0, - $03c1, $03c3, $03c2, $03c4, $03c5, $03c6, $03c7, $03c8, - $03c9 ); - -// Technical Byte 3 = $08 - keymap08 : array[161..254] of unichar = ( - $23b7, $250c, $2500, $2320, $2321, $2502, $23a1, $23a3, - $23a4, $23a6, $239b, $239d, $239e, $23a0, $23a8, $23ac, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $2264, $2260, $2265, $222b, $2234, - $221d, $221e, $0000, $0000, $2207, $0000, $0000, $223c, - $2243, $0000, $0000, $0000, $21d4, $21d2, $2261, $0000, - $0000, $0000, $0000, $0000, $0000, $221a, $0000, $0000, - $0000, $2282, $2283, $2229, $222a, $2227, $2228, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $2202, $0000, - $0000, $0000, $0000, $0000, $0000, $0192, $0000, $0000, - $0000, $0000, $2190, $2191, $2192, $2193 ); - -// Special Byte 3 = $09 - keymap09 : array[224..248] of unichar = ( - $25c6, $2592, $2409, $240c, $240d, $240a, $0000, $0000, - $2424, $240b, $2518, $2510, $250c, $2514, $253c, $23ba, - $23bb, $2500, $23bc, $23bd, $251c, $2524, $2534, $252c, - $2502 ); - -// Publishing Byte 3 = $0a = 10 - keymap10 : array[161..254] of unichar = ( - $2003, $2002, $2004, $2005, $2007, $2008, $2009, $200a, - $2014, $2013, $0000, $0000, $0000, $2026, $2025, $2153, - $2154, $2155, $2156, $2157, $2158, $2159, $215a, $2105, - $0000, $0000, $2012, $2329, $0000, $232a, $0000, $0000, - $0000, $0000, $215b, $215c, $215d, $215e, $0000, $0000, - $2122, $2613, $0000, $25c1, $25b7, $25cb, $25af, $2018, - $2019, $201c, $201d, $211e, $0000, $2032, $2033, $0000, - $271d, $0000, $25ac, $25c0, $25b6, $25cf, $25ae, $25e6, - $25ab, $25ad, $25b3, $25bd, $2606, $2022, $25aa, $25b2, - $25bc, $261c, $261e, $2663, $2666, $2665, $0000, $2720, - $2020, $2021, $2713, $2717, $266f, $266d, $2642, $2640, - $260e, $2315, $2117, $2038, $201a, $201e ); - -// APL Byte 3 = $0b = 11 - keymap11 : array[163..252] of unichar = ( - $003c, $0000, $0000, $003e, $0000, $2228, $2227, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $00af, $0000, $22a5, - $2229, $230a, $0000, $005f, $0000, $0000, $0000, $2218, - $0000, $2395, $0000, $22a4, $25cb, $0000, $0000, $0000, - $2308, $0000, $0000, $222a, $0000, $2283, $0000, $2282, - $0000, $22a2, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $22a3 ); - -// Hebrew Byte 3 = $0c = 12 - keymap12 : array[223..250] of unichar = ( - $2017, $05d0, $05d1, $05d2, $05d3, $05d4, $05d5, $05d6, - $05d7, $05d8, $05d9, $05da, $05db, $05dc, $05dd, $05de, - $05df, $05e0, $05e1, $05e2, $05e3, $05e4, $05e5, $05e6, - $05e7, $05e8, $05e9, $05ea ); - -// Thai Byte 3 = $0d = 13 - keymap13 : array[161..249] of unichar = ( - $0e01, $0e02, $0e03, $0e04, $0e05, $0e06, $0e07, $0e08, - $0e09, $0e0a, $0e0b, $0e0c, $0e0d, $0e0e, $0e0f, $0e10, - $0e11, $0e12, $0e13, $0e14, $0e15, $0e16, $0e17, $0e18, - $0e19, $0e1a, $0e1b, $0e1c, $0e1d, $0e1e, $0e1f, $0e20, - $0e21, $0e22, $0e23, $0e24, $0e25, $0e26, $0e27, $0e28, - $0e29, $0e2a, $0e2b, $0e2c, $0e2d, $0e2e, $0e2f, $0e30, - $0e31, $0e32, $0e33, $0e34, $0e35, $0e36, $0e37, $0e38, - $0e39, $0e3a, $0000, $0000, $0000, $0000, $0e3f, $0e40, - $0e41, $0e42, $0e43, $0e44, $0e45, $0e46, $0e47, $0e48, - $0e49, $0e4a, $0e4b, $0e4c, $0e4d, $0000, $0000, $0e50, - $0e51, $0e52, $0e53, $0e54, $0e55, $0e56, $0e57, $0e58, - $0e59 ); - -// Korean Byte 3 = $0e = 14 - keymap14 : array[161..255] of unichar = ( - $3131, $3132, $3133, $3134, $3135, $3136, $3137, $3138, - $3139, $313a, $313b, $313c, $313d, $313e, $313f, $3140, - $3141, $3142, $3143, $3144, $3145, $3146, $3147, $3148, - $3149, $314a, $314b, $314c, $314d, $314e, $314f, $3150, - $3151, $3152, $3153, $3154, $3155, $3156, $3157, $3158, - $3159, $315a, $315b, $315c, $315d, $315e, $315f, $3160, - $3161, $3162, $3163, $11a8, $11a9, $11aa, $11ab, $11ac, - $11ad, $11ae, $11af, $11b0, $11b1, $11b2, $11b3, $11b4, - $11b5, $11b6, $11b7, $11b8, $11b9, $11ba, $11bb, $11bc, - $11bd, $11be, $11bf, $11c0, $11c1, $11c2, $316d, $3171, - $3178, $317f, $3181, $3184, $3186, $318d, $318e, $11eb, - $11f0, $11f9, $0000, $0000, $0000, $0000, $20a9 ); - -// missing: -// Latin-8 Byte 3 = $12 = 18 - -// Latin-9 Byte 3 = $13 = 19 - keymap19 : array[188..190] of unichar = ( - $0152, $0153, $0178 ); - -// missing: -// Armenian Byte 3 = $14 = 20 -// Georgian Byte 3 = $15 = 21 -// Azeri Byte 3 = $16 = 22 -// Vietnamese Byte 3 = $1e = 30 - -// Currency Byte 3 = $20 = 32 - keymap32 : array[160..172] of unichar = ( - $20a0, $20a1, $20a2, $20a3, $20a4, $20a5, $20a6, $20a7, - $20a8, $0000, $20aa, $20ab, $20ac ); - -// Keyboard (Keypad mappings) Byte 3 = $ff = 255 - keymap255 : array[128..189] of unichar = ( - $0020, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $FF0D, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, - $0000, $0000, $002a, $002b, $002c, $002d, $002e, $002f, - $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, - $0038, $0039, $0000, $0000, $0000, $003d ); - -type - keymap = array[0..255] of word; - mapptr = ^keymap; - -procedure TranslateCode(var res : word; ccode : byte; map : mapptr; lowind,highind : byte); -begin - //writeln('code: ',ccode,' low: ',lowind,' high: ',highind); - if (ccode >= lowind) and (ccode <= highind) then res := map^[ccode-lowind]; -end; - -procedure KeySymToUnicode(ks : longword; res : PWord); -var - table : byte; - ccode : byte; -begin - table := ((ks and $0000FF00) shr 8); - ccode := ks and $ff; - res^ := ks and $FFFF; - case table of - 00 : TranslateCode(res^, ccode, @keymap00, low(keymap00), high(keymap00) ); - 01 : TranslateCode(res^, ccode, @keymap01, low(keymap01), high(keymap01) ); - 02 : TranslateCode(res^, ccode, @keymap02, low(keymap01), high(keymap02) ); - 03 : TranslateCode(res^, ccode, @keymap03, low(keymap01), high(keymap03) ); - 04 : TranslateCode(res^, ccode, @keymap04, low(keymap01), high(keymap04) ); - 05 : TranslateCode(res^, ccode, @keymap05, low(keymap01), high(keymap05) ); - 06 : TranslateCode(res^, ccode, @keymap06, low(keymap01), high(keymap06) ); - 07 : TranslateCode(res^, ccode, @keymap07, low(keymap01), high(keymap07) ); - 08 : TranslateCode(res^, ccode, @keymap08, low(keymap01), high(keymap08) ); - 09 : TranslateCode(res^, ccode, @keymap09, low(keymap01), high(keymap09) ); - - 10 : TranslateCode(res^, ccode, @keymap10, low(keymap10), high(keymap10) ); - 11 : TranslateCode(res^, ccode, @keymap11, low(keymap11), high(keymap11) ); - 12 : TranslateCode(res^, ccode, @keymap12, low(keymap12), high(keymap12) ); - 13 : TranslateCode(res^, ccode, @keymap13, low(keymap13), high(keymap13) ); - 14 : TranslateCode(res^, ccode, @keymap14, low(keymap14), high(keymap14) ); -// 15 : TranslateCode(res^, ccode, @keymap15, low(keymap15), high(keymap15) ); -// 16 : TranslateCode(res^, ccode, @keymap16, low(keymap16), high(keymap16) ); -// 17 : TranslateCode(res^, ccode, @keymap17, low(keymap17), high(keymap17) ); -// 18 : TranslateCode(res^, ccode, @keymap18, low(keymap18), high(keymap18) ); - 19 : TranslateCode(res^, ccode, @keymap19, low(keymap19), high(keymap19) ); - - 32 : TranslateCode(res^, ccode, @keymap32, low(keymap32), high(keymap32) ); - - 255 : TranslateCode(res^, ccode, @keymap255, low(keymap255), high(keymap255) ); - end; -end; - -end. diff --git a/prototypes/fpgui2/source/core/x11/x11_xft.pas b/prototypes/fpgui2/source/core/x11/x11_xft.pas deleted file mode 100644 index 805797cd..00000000 --- a/prototypes/fpgui2/source/core/x11/x11_xft.pas +++ /dev/null @@ -1,162 +0,0 @@ -{ - fpGFX - Free Pascal Graphics Library - Copyright (C) 2006-2007 by Graeme Geldenhuys - member of the fpGFX development team. - - Xft interface functions - - See the file COPYING.fpGFX, included in this distribution, - for details about the copyright. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - - **********************************************************************} - - -unit x11_xft; - -{$mode objfpc}{$H+} - -{$linklib Xft} - -interface -uses - Classes - ,SysUtils - ,X - ,XLib - ,Xutil - ; - - -type - TPicture = longword; - - TXftDraw = record - dummy : Pointer; - end; - PXftDraw = ^TXftDraw; - - TXftFont = record - ascent : integer; - descent : integer; - height : integer; - max_advance_width : integer; - ptr1 : Pointer; // charset - ptr2 : Pointer; // pattern - end; - PXftFont = ^TXftFont; - - TXRenderColor = record - red : word; - green : word; - blue : word; - alpha : word; - end; - - TXftColor = record - pixel : ptrint; - color : TXRenderColor; - end; - - TXGlyphInfo = packed record - width : word; - height : word; - x : smallint; - y : smallint; - xOff : smallint; - yOff : smallint; - end; - - TFcPattern = record - dummy : integer; - end; - - PFcPattern = ^TFcPattern; - PPFcPattern = ^PFcPattern; - - TFcFontSet = packed record - nfont : integer; - sfont : integer; - fonts : PPFcPattern; - end; - PFcFontSet = ^TFcFontSet; - -const - FC_FAMILY : PChar = 'family'; - FC_SIZE : PChar = 'size'; - FC_SCALABLE : PChar = 'scalable'; - - FcTypeVoid = 0; - FcTypeInteger = 1; - FcTypeDouble = 2; - FcTypeString = 3; - FcTypeBool = 4; - FcTypeMatrix = 5; - FcTypeCharSet = 6; - FcTypeFTFace = 7; - FcTypeLangSet = 8; - -function XftDrawCreate(display : PXDisplay; win : TXID; vis : PVisual; colorm : longint) : PXftDraw; cdecl; -procedure XftDrawChange(xftd : PXftDraw; win : TXID); cdecl; -procedure XftDrawDestroy(draw : PXftDraw); cdecl; - -function XftDrawPicture(draw : PXftDraw) : TPicture; cdecl; - -function XftFontOpenName(display : PXDisplay; scr : integer; par3 : PChar) : PXftFont; cdecl; -procedure XftFontClose(display : PXDisplay; fnt : PXftFont); cdecl; - -procedure XftDrawStringUtf8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; -procedure XftDrawString8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; -procedure XftDrawString16(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; - -procedure XftTextExtentsUtf8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; -procedure XftTextExtents8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; -procedure XftTextExtents16(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; - -//function XftGlyphExists(display : PXDisplay; fnt : PXftFont; ch : integer) : longbool; cdecl; - -//procedure XftDrawSetClipRectangles(draw : PXftDraw; xorigin, yorigin : integer; rect : PXRectangle; rnum : integer); cdecl; - -procedure XftDrawSetClip(draw : PXftDraw; rg : TRegion); cdecl; - -function XftListFonts(display : PXDisplay; screen : integer; params : array of const) : PFcFontSet; cdecl; -function XftNameUnparse(pat : PFcPattern; dest : PChar; destlen : integer) : boolean; cdecl; -procedure FcFontSetDestroy(fsp : PFcFontSet); cdecl; - - - -implementation - - -function XftDrawCreate(display : PXDisplay; win : TXID; vis : PVisual; colorm : longint) : PXftDraw; cdecl; external; -procedure XftDrawChange(xftd : PXftDraw; win : TXID); cdecl; external; -procedure XftDrawDestroy(draw : PXftDraw); cdecl; external; - -function XftDrawPicture(draw : PXftDraw) : TPicture; cdecl; external; - -function XftFontOpenName(display : PXDisplay; scr : integer; par3 : PChar) : PXftFont; cdecl; external; -procedure XftFontClose(display : PXDisplay; fnt : PXftFont); cdecl; external; - -procedure XftDrawStringUtf8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; external; -procedure XftDrawString8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; external; -procedure XftDrawString16(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; external; - -procedure XftTextExtentsUtf8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; external; -procedure XftTextExtents8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; external; -procedure XftTextExtents16(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; external; - -//function XftGlyphExists(display : PXDisplay; fnt : PXftFont; ch : integer) : longbool; cdecl; external; - -//procedure XftDrawSetClipRectangles(draw : PXftDraw; xorigin, yorigin : integer; rect : PXRectangle; rnum : integer); cdecl; external; - -procedure XftDrawSetClip(draw : PXftDraw; rg : TRegion); cdecl; external; - -function XftListFonts(display : PXDisplay; screen : integer; params : array of const) : PFcFontSet; cdecl; external; -function XftNameUnparse(pat : PFcPattern; dest : PChar; destlen : integer) : boolean; cdecl; external; -procedure FcFontSetDestroy(fsp : PFcFontSet); cdecl; external; - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_button.pas b/prototypes/fpgui2/source/gui/gui_button.pas deleted file mode 100644 index 6acc7a28..00000000 --- a/prototypes/fpgui2/source/gui/gui_button.pas +++ /dev/null @@ -1,417 +0,0 @@ -unit gui_button; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - gfxbase, - fpgfx, - gfx_widget; - -type - - TfpgButton = class(TfpgWidget) - private - FImageName: string; - FClicked: Boolean; - FShowImage: Boolean; - FClickOnPush: Boolean; - FGroupIndex: integer; - FAllowAllUp: boolean; - FModalResult: integer; - function GetFontDesc: string; - procedure SetEmbedded(const AValue: Boolean); - procedure SetFontDesc(const AValue: string); - procedure SetImageName(const AValue: string); - procedure SetText(const AValue: string); - procedure SetDown(AValue: Boolean); - procedure SetImageMargin(const Value: integer); - procedure SetImageSpacing(const Value: integer); - function GetAllowDown: Boolean; - procedure SetAllowDown(const Value: Boolean); - procedure SetAllowAllUp(const Value: boolean); - protected - FImageMargin: integer; - FImageSpacing: integer; - FEmbedded: Boolean; - FDown: Boolean; - FImage: TfpgImage; - FText: string; - FFont: TfpgFont; - procedure SetShowImage(AValue: Boolean); - procedure HandlePaint; override; - procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; - procedure HandleKeyRelease(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; - procedure HandleLMouseDown(X, Y: integer; ShiftState: TShiftState); override; - procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; - procedure HandleMouseExit; override; - procedure HandleMouseEnter; override; - public - OnClick: TNotifyEvent; - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure DoPush; - procedure DoRelease; - procedure Click; - property Down: Boolean read FDown write SetDown; - property Font: TfpgFont read FFont; - property AllowDown: Boolean read GetAllowDown write SetAllowDown; - published - property Text: string read FText write SetText; - property FontDesc: string read GetFontDesc write SetFontDesc; - property ImageName: string read FImageName write SetImageName; - property ImageMargin: integer read FImageMargin write SetImageMargin; - property ImageSpacing: integer read FImageSpacing write SetImageSpacing; - property GroupIndex: integer read FGroupIndex write FGroupIndex; - property AllowAllUp: boolean read FAllowAllUp write SetAllowAllUp; - property ModalResult: integer read FModalResult write FModalResult; - property Embedded: Boolean read FEmbedded write SetEmbedded default False; - property ShowImage: Boolean read FShowImage write SetShowImage default True; - end; - -function CreateButton(AOwner: TComponent; x, y, w: TfpgCoord; AText: string; - AOnClickEvent: TNotifyEvent): TfpgButton; - -implementation - -uses - gui_form; {$Note Try and remove this gui_form dependency.} - -function CreateButton(AOwner: TComponent; x, y, w: TfpgCoord; AText: string; - AOnClickEvent: TNotifyEvent): TfpgButton; -begin - Result := TfpgButton.Create(AOwner); - Result.Left := x; - Result.Top := y; - Result.Text := AText; - Result.Width := w; - Result.OnClick := AOnClickEvent; -end; - -{ TfpgButton } - -procedure TfpgButton.SetDown(AValue: Boolean); -begin - if AValue <> FDown then - begin - FDown := AValue; - if AllowDown then - RePaint; - end; -end; - -procedure TfpgButton.SetShowImage(AValue: Boolean); -begin - if AValue <> FShowImage then - begin - FShowImage := AValue; - if (FImage <> nil) and ShowImage then - RePaint; - end; -end; - -procedure TfpgButton.SetText(const AValue: string); -begin - if FText = AValue then - Exit; - FText := AValue; - RePaint; -end; - -procedure TfpgButton.SetImageName(const AValue: string); -begin - FImageName := AValue; - FImage := fpgImages.GetImage(FImageName); - Repaint; -end; - -function TfpgButton.GetFontDesc: string; -begin - Result := FFont.FontDesc; -end; - -procedure TfpgButton.SetEmbedded(const AValue: Boolean); -begin - if FEmbedded = AValue then - Exit; - FEmbedded := AValue; -end; - -procedure TfpgButton.SetFontDesc(const AValue: string); -begin - FFont.Free; - FFont := fpgGetFont(AValue); - RePaint; -end; - -constructor TfpgButton.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FText := 'Button'; - FFont := fpgGetFont('#Label1'); - FHeight := FFont.Height + 8; - FWidth := 75; - FFocusable := True; - OnClick := nil; - FDown := False; - FClicked := False; - FDown := False; - FClickOnPush := False; - FGroupIndex := 0; - FImage := nil; - FImageName := ''; - FShowImage := True; - FImageMargin := 3; - FImageSpacing := -1; - FModalResult := 0; - FEmbedded := False; -end; - -destructor TfpgButton.Destroy; -begin - FImage := nil; - FText := ''; - FFont.Free; - inherited Destroy; -end; - -procedure TfpgButton.HandlePaint; -var - AText: string; - x, y, iy, w: integer; - r: TfpgRect; - pofs: integer; - lBtnFlags: TFButtonFlags; -begin - Canvas.BeginDraw; -// inherited HandlePaint; - Canvas.Clear(clButtonFace); - Canvas.ClearClipRect; - - lBtnFlags := []; - if FDown then - Include(lBtnFlags, btnIsPressed); - - if FFocused and (not FEmbedded) then - Include(lBtnFlags, btnHasFocus); - - if FEmbedded then - Include(lBtnFlags, btnIsEmbedded); - - Canvas.DrawButtonFace(0, 0, Width, Height, lBtnFlags); - - if FFocused and (not FEmbedded) then - begin - Canvas.SetColor(clText1); - Canvas.SetLineStyle(1, lsDot); - Canvas.DrawRectangle(3, 3, Width - 6, Height - 6); - end - else - begin - Canvas.SetTextColor(clText1); - Canvas.SetColor(clText1); - end; - - r.left := 2; - r.top := 2; - r.Width := Width - 4; - r.Height := Height - 4; - Canvas.SetClipRect(r); - - Canvas.SetFont(Font); - AText := FText; - y := Height div 2 - FFont.Height div 2; - if y < 3 then - y := 3; - - if FDown then - pofs := 1 - else - pofs := 0; - - if (ShowImage) and (FImage <> nil) then - begin - iy := Height div 2 - FImage.Height div 2; - if ImageMargin = -1 then // centered - begin - w := FFont.TextWidth(AText) + FImage.Width; - if FImageSpacing > 0 then - Inc(w, FImageSpacing); - x := (Width div 2) - (w div 2); - if x < 3 then - x := 3; - end - else - begin - x := FImageMargin + 3; - end; - - Canvas.DrawImage(x + pofs, iy + pofs, FImage); - Inc(x, FImage.Width); - if FImageSpacing > 0 then - Inc(x, FImageSpacing); - - if (FImageSpacing = -1) and (FImageMargin >= 0) then - begin - w := (Width - 3 - x) div 2 - FFont.TextWidth(AText) div 2; - if w < 1 then - w := 1; // minimal spacing - x := x + w; - end; - end - else - x := (Width div 2) - (FFont.TextWidth(AText) div 2); - - if x < 3 then - x := 3; - - Canvas.DrawString(x + pofs, y + pofs, AText); - Canvas.EndDraw; -end; - -procedure TfpgButton.DoPush; -var - n: integer; - c: TComponent; -begin - FClickOnPush := (not FDown) and AllowDown; - - // search the other buttons in the group - for n := 0 to Parent.ComponentCount - 1 do - begin - c := Parent.Components[n]; - if (c <> self) and (c is TfpgButton) then - with TfpgButton(c) do - if GroupIndex = self.GroupIndex then - Down := False; - end; - - FDown := True; - FClicked := True; - - RePaint; - if FClickOnPush then - Click; -end; - -procedure TfpgButton.DoRelease; -begin - if AllowDown then - begin - if FDown and (not FClickOnPush) and FAllowAllUp then - begin - FDown := False; - RePaint; - Click; - end; - end - else - begin - if FDown and FClicked then - Click; - FDown := False; - RePaint; - end; - - FClickOnPush := False; - FClicked := False; -end; - -procedure TfpgButton.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); -begin - if (keycode = keyReturn) or (keycode = keySpace) then - begin - DoPush; - Consumed := True; - end - else - inherited; -end; - -procedure TfpgButton.HandleKeyRelease(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); -begin - if (keycode = keyReturn) or (keycode = keySpace) then - begin - DoRelease; - Consumed := True; - end - else - inherited; -end; - -procedure TfpgButton.HandleLMouseDown(X, Y: integer; ShiftState: TShiftState); -begin - inherited; - DoPush; -end; - -procedure TfpgButton.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); -begin - inherited; - DoRelease; -end; - -procedure TfpgButton.HandleMouseExit; -begin - inherited HandleMouseExit; - if FDown and (not AllowDown) then - begin - FDown := False; - RePaint; - end; -end; - -procedure TfpgButton.HandleMouseEnter; -begin - inherited HandleMouseEnter; - if FClicked and (not AllowDown) then - begin - FDown := True; - RePaint; - end; -end; - -procedure TfpgButton.Click; -var - pform: TfpgForm; -begin - pform := WidgetParentForm(self); - if pform <> nil then - pform.ModalResult := ModalResult; - - if Assigned(OnClick) then - OnClick(self); -end; - -procedure TfpgButton.SetImageMargin(const Value: integer); -begin - FImageMargin := Value; - Repaint; -end; - -procedure TfpgButton.SetImageSpacing(const Value: integer); -begin - FImageSpacing := Value; - Repaint; -end; - -function TfpgButton.GetAllowDown: Boolean; -begin - Result := GroupIndex > 0; -end; - -procedure TfpgButton.SetAllowDown(const Value: Boolean); -begin - GroupIndex := 1; -end; - -procedure TfpgButton.SetAllowAllUp(const Value: boolean); -begin - FAllowAllUp := Value; -end; - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_combobox.pas b/prototypes/fpgui2/source/gui/gui_combobox.pas deleted file mode 100644 index d45f4020..00000000 --- a/prototypes/fpgui2/source/gui/gui_combobox.pas +++ /dev/null @@ -1,197 +0,0 @@ -unit gui_combobox; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - gfx_widget, - gui_form, - gfxbase, - gui_button; - -type - - { TfpgCustomComboBox } - - TfpgCustomComboBox = class(TfpgWidget) - private - FDropDownCount: integer; - FDropDown: TfpgForm; - FBackgroundColor: TfpgColor; - FInternalBtn: TfpgButton; - procedure SetDropDownCount(const AValue: integer); - procedure DoDropDown; - procedure InternalBtnClick(Sender: TObject); - protected - property DropDownCount: integer read FDropDownCount write SetDropDownCount default 8; - procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; - procedure HandlePaint; override; - public - constructor Create(AOwner: TComponent); override; - procedure AfterConstruction; override; - end; - - - TfpgComboBox = class(TfpgCustomComboBox) - published - property DropDownCount; - end; - - -function CreateComboBox(AOwner: TComponent; x, y, w: TfpgCoord; AList: TStringList): TfpgComboBox; - - -implementation - -uses - fpgfx, - Math; - -type - // This is so we can access protected methods - TPrivateWidget = class(TfpgWidget) - end; - - { TDropDownWindow } - - TDropDownWindow = class(TfpgForm) - protected - procedure HandlePaint; override; - public - constructor Create(AOwner: TComponent); override; - end; - -{ TDropDownWindow } - -procedure TDropDownWindow.HandlePaint; -begin - Canvas.BeginDraw; - inherited HandlePaint; - Canvas.Clear(clWhite); - Canvas.SetColor(clYellow); - Canvas.SetLineStyle(2, lsSolid); - Canvas.DrawRectangle(1, 1, Width-1, Height-1); - Canvas.EndDraw; -end; - -constructor TDropDownWindow.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WindowType := wtPopup; - WindowAttributes := []; - WindowPosition := wpUser; -end; - - -function CreateComboBox(AOwner: TComponent; x, y, w: TfpgCoord; AList: TStringList): TfpgComboBox; -begin - Result := TfpgComboBox.Create(AOwner); - Result.Left := x; - Result.Top := y; - Result.Width := w; - Result.Focusable := True; - - Result.Height := 23; // replace this with font height + margins - {$Note We still need to handle the AList param as well.} -end; - -{ TfpgCustomComboBox } - -procedure TfpgCustomComboBox.SetDropDownCount(const AValue: integer); -begin - if FDropDownCount = AValue then - Exit; - FDropDownCount := AValue; -end; - -procedure TfpgCustomComboBox.DoDropDown; -var - pt: TPoint; -begin - if (not Assigned(FDropDown)) or (not FDropDown.HasHandle) then - begin - pt := WindowToScreen(Parent, Point(Left, Top+Height)); - FDropDown := TDropDownWindow.Create(nil); - FDropDown.Left := pt.X; - FDropDown.Top := pt.Y; - FDropDown.Width := Width; - FDropDown.Height := (DropDownCount * (Height-4)); - FDropDown.Show; - end - else - begin - FDropDown.Close; - FreeAndNil(FDropDown); - end; -end; - -procedure TfpgCustomComboBox.InternalBtnClick(Sender: TObject); -begin - DoDropDown; -end; - -procedure TfpgCustomComboBox.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); -begin - inherited HandleLMouseDown(x, y, shiftstate); - DoDropDown; -end; - -procedure TfpgCustomComboBox.HandlePaint; -var - r: TfpgRect; -begin - inherited HandlePaint; - Canvas.BeginDraw; - Canvas.ClearClipRect; - Canvas.DrawControlFrame(0, 0, Width, Height); - - // internal background rectangle (without frame) - r.Left := 2; - r.Top := 2; - r.Width := Width - 4; - r.Height := Height - 4; - Canvas.SetClipRect(r); - - if Enabled then - Canvas.SetColor(FBackgroundColor) - else - Canvas.SetColor(clWindowBackground); - // we already set the clip rectangle so we can paint full size - Canvas.FillRectAngle(2, 2, Width - 4, Height - 4); - // Canvas.FillRectAngle(0,0,Width,Height); - -// fpgStyle.DrawButtonFace(canvas, width - min(height, 20)-3, 2, height-4, height-4, [btnIsEmbedded]); -// fpgStyle.DrawDirectionArrow(canvas, width - height + 1, 1, height-2, height-2, 1); - - Canvas.EndDraw; -end; - -constructor TfpgCustomComboBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FBackgroundColor := clBoxColor; - FDropDownCount := 8; - FWidth := 120; - Height := 23; -end; - -procedure TfpgCustomComboBox.AfterConstruction; -begin - inherited AfterConstruction; - - if not Assigned(FInternalBtn) then - begin - FInternalBtn := CreateButton(self, (Width-19), 2, 18, '', @InternalBtnClick); - FInternalBtn.Height := 19; - FInternalBtn.Embedded := True; - FInternalBtn.Parent := self; - FInternalBtn.ImageName := 'sys.sb.down'; - FInternalBtn.ShowImage := True; - end; -end; - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_dialogs.pas b/prototypes/fpgui2/source/gui/gui_dialogs.pas deleted file mode 100644 index 93144e05..00000000 --- a/prototypes/fpgui2/source/gui/gui_dialogs.pas +++ /dev/null @@ -1,218 +0,0 @@ -unit gui_dialogs; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, fpgfx, gui_form, gui_button, gui_label; - -type - - { TfpgMessageBox } - - TfpgMessageBox = class(TfpgForm) - private - FLines: TStringList; - FFont: TfpgFont; - FTextY: integer; - FLineHeight: integer; - FMaxLineWidth: integer; - FButton: TfpgButton; - procedure ButtonClick(Sender: TObject); - protected - procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; - procedure HandlePaint; override; - public - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; - procedure SetMessage(AMessage: string); - end; - - -procedure ShowMessage(AMessage, ATitle: string); overload; -procedure ShowMessage(AMessage: string); overload; - - -implementation - -uses - gfxbase, gfx_utf8utils; - - -procedure ShowMessage(AMessage, ATitle: string); -var - frm: TfpgMessageBox; -begin - frm := TfpgMessageBox.Create(nil); - try - frm.WindowTitle := ATitle; - frm.SetMessage(AMessage); - frm.ShowModal; - finally - frm.Free; - end; -end; - -procedure ShowMessage(AMessage: string); -begin - ShowMessage(AMessage, 'Message'); -end; - - -{ TfpgMessageBox } - -procedure TfpgMessageBox.ButtonClick(Sender: TObject); -begin - ModalResult := 1; -end; - -procedure TfpgMessageBox.HandleKeyPress(var keycode: word; - var shiftstate: TShiftState; var consumed: boolean); -begin - inherited HandleKeyPress(keycode, shiftstate, consumed); - if keycode = keyEscape then - Close; -end; - -procedure TfpgMessageBox.HandlePaint; -var - n, y: integer; - tw: integer; -begin - Canvas.BeginDraw; - inherited HandlePaint; - -// canvas.Clear(FBackgroundColor); - Canvas.SetFont(FFont); - - y := FTextY; - for n := 0 to FLines.Count-1 do - begin - tw := FFont.TextWidth(FLines[n]); - Canvas.DrawString(Width div 2 - tw div 2, y, FLines[n]); - Inc(y, FLineHeight); - end; - Canvas.EndDraw; -end; - -constructor TfpgMessageBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WindowAttributes := [waAutoPos]; - - FLines := TStringList.Create; - FFont := fpgGetFont('#Label1'); - FTextY := 10; - FLineHeight := FFont.Height + 4; - MinWidth := 200; - FMaxLineWidth := 500; - - FButton := TfpgButton.Create(self); - FButton.text := 'OK'; // We must localize this - FButton.Width := 75; - FButton.OnClick := @ButtonClick; - -end; - -destructor TfpgMessageBox.Destroy; -begin - FFont.Free; - FLines.Free; - inherited Destroy; -end; - -procedure TfpgMessageBox.SetMessage(AMessage: string); -var - maxw: integer; - n: integer; - s, s2: string; - c: char; - - // ----------------- - procedure AddLine(all: boolean); - var - w: integer; - m: integer; - begin - s2 := s; - w := FFont.TextWidth(s2); - if w > FMaxLineWidth then - begin - while w > FMaxLineWidth do - begin - m := UTF8Length(s); - repeat - Dec(m); - s2 := UTF8Copy(s,1,m); - w := FFont.TextWidth(s2); - until w <= FMaxLineWidth; - if w > maxw then - maxw := w; - - // are we in the middle of a word. If so find the beginning of word. - while UTF8Copy(s2, m, m+1) <> ' ' do - begin - Dec(m); - s2 := UTF8Copy(s,1,m); - end; - - FLines.Add(s2); - s := UTF8Copy(s, m+1, UTF8length(s)); - s2 := s; - w := FFont.TextWidth(s2); - end; { while } - if all then - begin - FLines.Add(s2); - s := ''; - end; - end - else - begin - FLines.Add(s2); - s := ''; - end; { if/else } - - if w > maxw then - maxw := w; - end; - -begin - s := ''; - FLines.Clear; - n := 1; - maxw := 0; - while n <= length(AMessage) do - begin - c := AMessage[n]; - if (c = #13) or (c = #10) then - begin - AddLine(false); - if (c = #13) and (n < length(AMessage)) and (AMessage[n+1] = #10) then - Inc(n); - end - else - s := s + c; - Inc(n); - end; { while } - - AddLine(true); - - // dialog width with 10 pixel border on both sides - Width := maxw + 2*10; - - if Width < FMinWidth then - Width := FMinWidth; - - // center button - FButton.Top := FTextY + FLineHeight*FLines.Count + FTextY; - FButton.Left := (Width div 2) - (FButton.Width div 2); - - // adjust dialog's height - Height := FButton.Top + FButton.Height + FTextY; -end; - - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_edit.pas b/prototypes/fpgui2/source/gui/gui_edit.pas deleted file mode 100644 index 15aff0da..00000000 --- a/prototypes/fpgui2/source/gui/gui_edit.pas +++ /dev/null @@ -1,503 +0,0 @@ -unit gui_edit; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - gfxbase, - fpgfx, - gfx_widget; - -type - TfpgCustomEdit = class(TfpgWidget) - end; - - TfpgEdit = class(TfpgCustomEdit) - private - FText: string; - FMaxLength: integer; - FCursorPos: integer; - FSideMargin: integer; - FBackgroundColor: TfpgColor; - FSelStart, FSelOffset: integer; - FSelecting: boolean; - FMouseDragPos: integer; - FFont: TfpgFont; - FDrawOffset: integer; - function GetFontName: string; - procedure SetFontName(const AValue: string); - procedure SetText(const AValue: string); - procedure DeleteSelection; - procedure DoCopy; - procedure DoPaste; - procedure AdjustCursor; - function GetDrawText: string; - procedure HandlePaint; override; - procedure HandleKeyChar(var AText: string; var shiftstate: TShiftState; var consumed: boolean); override; - procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; - procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; - procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; - public - PasswordMode: boolean; - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - function SelectionText: string; - property Font: TfpgFont read FFont; - OnChange: TNotifyEvent; - published - property Text: string read FText write SetText; - property FontName: string read GetFontName write SetFontName; - end; - -function CreateEdit(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgEdit; - -implementation - -uses - gfx_UTF8utils; - -function CreateEdit(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgEdit; -begin - Result := TfpgEdit.Create(AOwner); - Result.Left := x; - Result.Top := y; - Result.Width := w; - if h > 0 then - Result.Height := h; -end; - -{ TfpgEdit } - -constructor TfpgEdit.Create(AOwner: TComponent); -begin - inherited; - Focusable := True; - - FFont := fpgGetFont('#Edit1'); // owned object ! - - FHeight := FFont.Height + 6; - FWidth := 120; - FBackgroundColor := clBoxColor; - FSelecting := False; - FSideMargin := 3; - FMaxLength := 0; - FText := ''; - FCursorPos := UTF8Length(FText); - FSelStart := FCursorPos; - FSelOffset := 0; - FDrawOffset := 0; - PasswordMode := False; - - OnChange := nil; -end; - -destructor TfpgEdit.Destroy; -begin - FFont.Free; - inherited Destroy; -end; - -procedure TfpgEdit.SetText(const AValue: string); -begin - if FText = AValue then - Exit; - - FText := AValue; - FCursorPos := UTF8Length(FText); - FSelStart := FCursorPos; - FSelOffset := 0; - FDrawOffset := 0; - - AdjustCursor; - if FWinHandle > 0 then - RePaint; -end; - -function TfpgEdit.GetFontName: string; -begin - Result := FFont.FontDesc; -end; - -procedure TfpgEdit.SetFontName(const AValue: string); -begin - FFont.Free; - FFont := fpgGetFont(AValue); - RePaint; -end; - -procedure TfpgEdit.DeleteSelection; -begin - if FSelOffset <> 0 then - begin - if FSelOffset < 0 then - begin - Delete(FText, 1 + FSelStart + FSelOffset, -FSelOffset); - FCurSorPos := FSelStart + FSelOffset; - end - else - begin - Delete(FText, 1 + FSelStart, FSelOffset); - FCurSorPos := FSelStart; - end; - FSelOffset := 0; - FSelStart := FCursorPos; - end; -end; - -procedure TfpgEdit.DoCopy; -begin - if FSelOffset = 0 then - Exit; - //SetClipboardText(SelectionText); -end; - -procedure TfpgEdit.DoPaste; -var - s: string; -begin - DeleteSelection; - //s := GetClipboardText; - if (FMaxLength > 0) then - if UTF8Length(FText) + UTF8Length(s) > FMaxLength then - s := UTF8Copy(s, 1, FMaxLength - UTF8Length(FText)); // trim the clipboard text if needed - - if UTF8Length(s) < 1 then - Exit; //==> - {$Note Is Insert() UTF-8 safe? } - Insert(s, FText, FCursorPos + 1); - FCursorPos := FCursorPos + UTF8Length(s); - AdjustCursor; - Repaint; -end; - -procedure TfpgEdit.AdjustCursor; -var - tw: integer; - VisibleWidth: integer; -begin - tw := FFont.TextWidth(UTF8Copy(GetDrawText, 1, FCursorPos)); - VisibleWidth := (FWidth - 2 * FSideMargin); - - if tw - FDrawOffset > VisibleWidth - 2 then - FDrawOffset := tw - VisibleWidth + 2 - else if tw - FDrawOffset < 0 then - begin - FDrawOffset := tw; - if tw <> 0 then - Dec(FDrawOffset, 2); - end; -end; - -function TfpgEdit.GetDrawText: string; -begin - if not PassWordMode then - Result := FText - else - Result := StringOfChar('*', UTF8Length(FText)); -end; - -procedure TfpgEdit.HandlePaint; -var - r: TfpgRect; - tw, tw2, st, len: integer; - dtext: string; -begin - Canvas.BeginDraw; - Canvas.ClearClipRect; - Canvas.DrawControlFrame(0, 0, Width, Height); - - r.Left := 2; - r.Top := 2; - r.Width := Width - 4; - r.Height := Height - 4; - Canvas.SetClipRect(r); - - if Enabled then - Canvas.SetColor(FBackgroundColor) - else - Canvas.SetColor(clWindowBackground); - - Canvas.FillRectAngle(2, 2, Width - 4, Height - 4); - dtext := GetDrawText; - Canvas.SetTextColor(clText1); - Canvas.SetFont(FFont); - Canvas.DrawString(-FDrawOffset + FSideMargin, 3, dtext); - - if Focused then - begin - // drawing selection - if FSelOffset <> 0 then - begin - len := FSelOffset; - st := FSelStart; - if len < 0 then - begin - st := st + len; - len := -len; - end; - - tw := FFont.TextWidth(UTF8copy(dtext, 1, st)); - tw2 := FFont.TextWidth(UTF8copy(dtext, 1, st + len)); - Canvas.XORFillRectangle(fpgColorToRGB(clSelection) xor $FFFFFF, -FDrawOffset + - FSideMargin + tw, 3, tw2 - tw, FFont.Height); - end; - - // drawing cursor - tw := FFont.TextWidth(UTF8copy(dtext, 1, FCursorPos)); - fpgCaret.SetCaret(Canvas, -FDrawOffset + FSideMargin + tw, 3, 2, FFont.Height - 1); - end - else - fpgCaret.UnSetCaret(Canvas); - - Canvas.EndDraw; -end; - -procedure TfpgEdit.HandleKeyChar(var AText: string; - var shiftstate: TShiftState; var consumed: boolean); -var - s: string; - prevval: string; -begin - prevval := Text; - s := AText; - consumed := False; - - // Handle only printable characters - // Note: This is not UTF-8 compliant! - if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) then - begin - if (FMaxLength <= 0) or (UTF8Length(FText) < FMaxLength) then - begin - DeleteSelection; - Insert(s, FText, FCursorPos + 1); - Inc(FCursorPos); - FSelStart := FCursorPos; - AdjustCursor; - end; - consumed := True; - end; - - if prevval <> Text then - if Assigned(OnChange) then - OnChange(self); - - if consumed then - RePaint - else - inherited HandleKeyChar(AText, shiftstate, consumed); -end; - -procedure TfpgEdit.HandleKeyPress(var keycode: word; - var shiftstate: TShiftState; var consumed: boolean); - - procedure StopSelection; - begin - FSelStart := FCursorPos; - FSelOffset := 0; - end; - -begin - Consumed := False; -{ - Consumed := true; - case ptkCheckClipBoardKey(keycode, shiftstate) of - ckCopy: DoCopy; - ckPaste: DoPaste; - ckCut: begin - DoCopy; - DeleteSelection; - end; - else - Consumed := false; - end; -} - - if not Consumed then - begin - // checking for movement keys: - consumed := True; - - case keycode of - keyLeft: - if FCursorPos > 0 then - begin - Dec(FCursorPos); - - if (ssCtrl in shiftstate) then - // word search... - // while (FCursorPos > 0) and not ptkIsAlphaNum(copy(FText,FCursorPos,1)) - // do Dec(FCursorPos); - // while (FCursorPos > 0) and ptkIsAlphaNum(copy(FText,FCursorPos,1)) - // do Dec(FCursorPos); - ; - - end; - - keyRight: - if FCursorPos < UTF8Length(FText) then - begin - Inc(FCursorPos); - - if (ssCtrl in shiftstate) then - // word search... - // while (FCursorPos < Length(FText)) and ptkIsAlphaNum(copy(FText,FCursorPos+1,1)) - // do Inc(FCursorPos); - // while (FCursorPos < Length(FText)) and not ptkIsAlphaNum(copy(FText,FCursorPos+1,1)) - // do Inc(FCursorPos); - ; - end; - - keyHome: - FCursorPos := 0; - - keyEnd: - FCursorPos := UTF8Length(FText); - else - Consumed := False; - end; - - if Consumed then - begin - AdjustCursor; - - FSelecting := (ssShift in shiftstate); - - if FSelecting then - FSelOffset := FCursorPos - FSelStart - else - StopSelection; - end; - end; // movement key checking - - if not Consumed then - begin - consumed := True; - - case keycode of - keyBackSpace: - if FCursorPos > 0 then - begin - Delete(FText, FCursorPos, 1); - Dec(FCursorPos); - end;// backspace - - - keyDelete: - if FSelOffset <> 0 then - DeleteSelection - else if FCursorPos < UTF8Length(FText) then - Delete(FText, FCursorPos + 1, 1); - else - Consumed := False; - end; - - if Consumed then - begin - StopSelection; - AdjustCursor; - end; - end; { if } - - if consumed then - RePaint - else - inherited; -end; - -procedure TfpgEdit.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); -var - s: string; - n: integer; - cpx: integer; - cp: integer; - cx: integer; - dtext: string; -begin - inherited HandleLMouseDown(x, y, shiftstate); - - // searching the appropriate character position - dtext := GetDrawText; - cpx := FFont.TextWidth(UTF8Copy(dtext, 1, FCursorPos)) - FDrawOffset + FSideMargin; - cp := FCursorPos; - s := ''; - - for n := 0 to UTF8Length(dtext) do - begin - cx := FFont.TextWidth(UTF8Copy(dtext, 1, n)) - FDrawOffset + FSideMargin; - if abs(cx - x) < abs(cpx - x) then - begin - cpx := cx; - cp := n; - end; - end; - - FMouseDragPos := cp; - FCursorPos := cp; - - if (ssShift in shiftstate) then - FSelOffset := FCursorPos - FSelStart - else - begin - FSelStart := cp; - FSelOffset := 0; - end; - Repaint; -end; - -procedure TfpgEdit.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); -var - s: string; - n: integer; - cpx: integer; - cp: integer; - cx: integer; - dtext: string; -begin - if (btnstate and MOUSE_LEFT) = 0 then - Exit; - - // searching the appropriate character position - dtext := GetDrawText; - cpx := FFont.TextWidth(UTF8Copy(dtext, 1, FCursorPos)) - FDrawOffset + FSideMargin; - cp := FCursorPos; - s := ''; - - for n := 0 to UTF8Length(dtext) do - begin - cx := FFont.TextWidth(UTF8Copy(dtext, 1, n)) - FDrawOffset + FSideMargin; - if abs(cx - x) < abs(cpx - x) then - begin - cpx := cx; - cp := n; - end; - end; - - //FMouseDragPos := cp; - FSelOffset := cp - FSelStart; - if FCursorPos <> cp then - begin - FCursorPos := cp; - Repaint; - end; -end; - -function TfpgEdit.SelectionText: string; -begin - if FSelOffset <> 0 then - begin - if FSelOffset < 0 then - Result := UTF8Copy(FText, 1 + FSelStart + FSelOffset, -FSelOffset) - else - begin - Result := UTF8Copy(FText, 1 + FSelStart, FSelOffset); - end; - end - else - Result := ''; -end; - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_form.pas b/prototypes/fpgui2/source/gui/gui_form.pas deleted file mode 100644 index c839492b..00000000 --- a/prototypes/fpgui2/source/gui/gui_form.pas +++ /dev/null @@ -1,270 +0,0 @@ -unit gui_form; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - gfxbase, - gfx_widget; - -type - TWindowPosition = (wpUser, wpAuto, wpScreenCenter); - - - TfpgForm = class(TfpgWidget) - private - FOnActivate: TNotifyEvent; - FOnClose: TNotifyEvent; - FOnCreate: TNotifyEvent; - FOnDeactivate: TNotifyEvent; - FOnDestroy: TNotifyEvent; - FOnHide: TNotifyEvent; - FOnShow: TNotifyEvent; - protected - FPrevModalForm: TfpgForm; - FModalResult: integer; - FParentForm: TfpgForm; - FWindowPosition: TWindowPosition; - FWindowTitle: string; - FSizeable: boolean; - FBackgroundColor: TfpgColor; - procedure AdjustWindowStyle; override; - procedure SetWindowParameters; override; - procedure SetWindowTitle(const ATitle: string); override; - procedure MsgActivate(var msg: TfpgMessageRec); message FPGM_ACTIVATE; - procedure MsgDeActivate(var msg: TfpgMessageRec); message FPGM_DEACTIVATE; - procedure MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE; - procedure HandlePaint; override; - procedure HandleClose; virtual; - procedure HandleHide; override; - procedure HandleShow; override; - procedure AfterConstruction; override; - procedure BeforeDestruction; override; - public - constructor Create(AOwner: TComponent); override; - procedure AfterCreate; virtual; - procedure Show; - procedure Hide; - function ShowModal: integer; - procedure Close; - property Sizeable: boolean read FSizeable write FSizeable; - property WindowPosition: TWindowPosition read FWindowPosition write FWindowPosition; - property WindowTitle: string read FWindowTitle write SetWindowTitle; - property ModalResult: integer read FModalResult write FModalResult; - published - {$Note Refactor this to a TfpgCustomForm and only surface it here } - property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; - property OnClose: TNotifyEvent read FOnClose write FOnClose; - property OnCreate: TNotifyEvent read FOnCreate write FOnCreate; - property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; - property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; - property OnHide: TNotifyEvent read FOnHide write FOnHide; - property OnShow: TNotifyEvent read FOnShow write FOnShow; - end; - - -var - // Don't like this. It's a bit of a hack. Possibly move this into - // fpgApplication, but do we want fpgApplication to have that dependency?? - fpgMainForm: TfpgForm; - fpgTopModalForm: TfpgForm; - -function WidgetParentForm(wg: TfpgWidget): TfpgForm; - - -implementation - -uses - fpgfx; - -function WidgetParentForm(wg: TfpgWidget): TfpgForm; -var - w: TfpgWidget; -begin - w := wg; - while w <> nil do - begin - if w is TfpgForm then - begin - Result := TfpgForm(w); - Exit; - end; - w := w.Parent; - end; - Result := nil; -end; - -{ TfpgForm } - -procedure TfpgForm.SetWindowTitle(const ATitle: string); -begin - FWindowTitle := ATitle; - inherited SetWindowTitle(ATitle); -end; - -procedure TfpgForm.MsgActivate(var msg: TfpgMessageRec); -begin - if (fpgTopModalForm = nil) or (fpgTopModalForm = self) then - begin - FocusRootWidget := self; - if ActiveWidget = nil then - ActiveWidget := FindFocusWidget(nil, fsdFirst) - else - ActiveWidget.SetFocus; - end; - if Assigned(FOnActivate) then - FOnActivate(self); -end; - -procedure TfpgForm.MsgDeActivate(var msg: TfpgMessageRec); -begin - if ActiveWidget <> nil then - ActiveWidget.KillFocus; - if Assigned(FOnDeactivate) then - FOnDeactivate(self); -end; - -procedure TfpgForm.HandlePaint; -begin - Canvas.BeginDraw; - inherited; - Canvas.Clear(FBackgroundColor); - Canvas.EndDraw(0, 0, FWidth, FHeight); -end; - -procedure TfpgForm.AdjustWindowStyle; -begin - if fpgMainForm = nil then - fpgMainForm := self; - - if FWindowPosition = wpAuto then - Include(FWindowAttributes, waAutoPos) - else - Exclude(FWindowAttributes, waAutoPos); - - if FWindowPosition = wpScreenCenter then - Include(FWindowAttributes, waScreenCenterPos) - else - Exclude(FWindowAttributes, waScreenCenterPos); - - if FSizeable then - Include(FWindowAttributes, waSizeable) - else - Exclude(FWindowAttributes, waSizeable); -end; - -procedure TfpgForm.SetWindowParameters; -begin - inherited; - DoSetWindowTitle(FWindowTitle); -end; - -constructor TfpgForm.Create(AOwner: TComponent); -begin - inherited; - FWindowPosition := wpUser; - FWindowTitle := ''; - FSizeable := True; - FParentForm := nil; - FBackgroundColor := clWindowBackground; - FMinWidth := 32; - FMinHeight := 32; - FModalResult := 0; - FPrevModalForm := nil; - - AfterCreate; -end; - -procedure TfpgForm.AfterCreate; -begin - // for the user -end; - -procedure TfpgForm.Show; -begin - HandleShow; -end; - -function TfpgForm.ShowModal: integer; -begin - FPrevModalForm := fpgTopModalForm; - fpgTopModalForm := self; - ModalResult := 0; - - Show; - // processing messages until this form ends. - // delivering the remaining messages - fpgApplication.ProcessMessages; - repeat - fpgWaitWindowMessage; - until (ModalResult <> 0) or (not Visible); - - fpgTopModalForm := FPrevModalForm; - Result := ModalResult; -end; - -procedure TfpgForm.MsgClose(var msg: TfpgMessageRec); -begin - HandleClose; - if Assigned(FOnClose) then - FOnClose(self); -end; - -procedure TfpgForm.HandleClose; -begin - Close; -end; - -procedure TfpgForm.HandleHide; -begin - inherited HandleHide; - if Assigned(FOnHide) then - FOnHide(self); -end; - -procedure TfpgForm.HandleShow; -begin - inherited HandleShow; - if Assigned(FOnShow) then - FOnShow(self); -end; - -procedure TfpgForm.AfterConstruction; -begin - inherited AfterConstruction; - if Assigned(FOnCreate) then - FOnCreate(self); -end; - -procedure TfpgForm.BeforeDestruction; -begin - inherited BeforeDestruction; - if Assigned(FOnDestroy) then - FOnDestroy(self); -end; - -procedure TfpgForm.Hide; -begin - if (fpgTopModalForm = self) then - fpgTopModalForm := self.FPrevModalForm; - HandleHide; - if ModalResult = 0 then - ModalResult := -1; -end; - -procedure TfpgForm.Close; -begin - Hide; - if fpgMainForm = self then - Halt(0); -end; - -initialization - fpgMainForm := nil; - fpgTopModalForm := nil; - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_label.pas b/prototypes/fpgui2/source/gui/gui_label.pas deleted file mode 100644 index b3d7f9b7..00000000 --- a/prototypes/fpgui2/source/gui/gui_label.pas +++ /dev/null @@ -1,124 +0,0 @@ -unit gui_label; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - gfxbase, - fpgfx, - gfx_widget; - -type - - TfpgLabel = class(TfpgWidget) - private - FBackgroundColor: TfpgColor; - FColor: TfpgColor; - function GetFontDesc: string; - procedure SetBackgroundColor(const AValue: TfpgColor); - procedure SetFontDesc(const AValue: string); - procedure SetColor(const AValue: TfpgColor); - procedure SetText(const AValue: string); - protected - FText: string; - FFont: TfpgFont; - procedure HandlePaint; override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property Font: TfpgFont read FFont; - published - property Text: string read FText write SetText; - property FontDesc: string read GetFontDesc write SetFontDesc; - property Color: TfpgColor read FColor write SetColor; - property BackgroundColor: TfpgColor read FBackgroundColor write SetBackgroundColor; - property OnMouseMove; - end; - - TLabelClass = class of TfpgLabel; - -function CreateLabel(AOwner: TComponent; x, y: TfpgCoord; AText: string): TfpgLabel; - -implementation - -function CreateLabel(AOwner: TComponent; x, y: TfpgCoord; AText: string): TfpgLabel; -begin - Result := TfpgLabel.Create(AOwner); - Result.Left := x; - Result.Top := y; - Result.Text := AText; - Result.Width := Result.Font.TextWidth(Result.Text); -end; - -{ TfpgLabel } - -procedure TfpgLabel.SetColor(const AValue: TfpgColor); -begin - if FColor = AValue then - Exit; - FColor := AValue; - RePaint; -end; - -function TfpgLabel.GetFontDesc: string; -begin - Result := FFont.FontDesc; -end; - -procedure TfpgLabel.SetBackgroundColor(const AValue: TfpgColor); -begin - if FBackgroundColor = AValue then - Exit; - FBackgroundColor := AValue; - RePaint; -end; - -procedure TfpgLabel.SetFontDesc(const AValue: string); -begin - FFont.Free; - FFont := fpgGetFont(AValue); - RePaint; -end; - -procedure TfpgLabel.SetText(const AValue: string); -begin - if FText = AValue then - Exit; - FText := AValue; - RePaint; -end; - -constructor TfpgLabel.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FText := 'Label'; - FFont := fpgGetFont('#Label1'); - FHeight := FFont.Height; - FWidth := 80; - FColor := clText1; - FBackgroundColor := clWindowBackground; -end; - -destructor TfpgLabel.Destroy; -begin - FText := ''; - FFont.Free; - inherited Destroy; -end; - -procedure TfpgLabel.HandlePaint; -begin - Canvas.BeginDraw; - inherited; - Canvas.Clear(FBackgroundColor); - Canvas.SetFont(Font); - Canvas.SetTextColor(FColor); - Canvas.DrawString(0, 0, FText); - Canvas.EndDraw; -end; - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_listbox.pas b/prototypes/fpgui2/source/gui/gui_listbox.pas deleted file mode 100644 index 0cf08353..00000000 --- a/prototypes/fpgui2/source/gui/gui_listbox.pas +++ /dev/null @@ -1,614 +0,0 @@ -unit gui_listbox; - -{$mode objfpc}{$H+} - -{ - TODO: - * Refactor these to have a better hierarchy - * Only surface properties as published in TfpgListBox -} - -interface - -uses - Classes, - SysUtils, - gfx_widget, - gui_scrollbar, - gfxbase, - fpgfx; - -type - - // My thinking was that we could use this class as the base class for anything - // that contains a list and needs to be presented like a normal listBox. - // Not sure if it is actually going to work. - TfpgBaseListBox = class(TfpgWidget) - private - FHotTrack: boolean; - FOnChange: TNotifyEvent; - FOnSelect: TNotifyEvent; - FPopupFrame: boolean; - function GetFontDesc: string; - procedure SetFocusItem(const AValue: integer); - procedure SetFontDesc(const AValue: string); - procedure SetPopupFrame(const AValue: boolean); - procedure UpdateScrollbarCoords; - protected - FFont: TfpgFont; - FScrollBar: TfpgScrollBar; - FFocusItem: integer; - FMouseDragging: boolean; - FFirstItem: integer; - FMargin: integer; - FBackgroundColor: TfpgColor; // This should move to TfpgWidget - procedure SetFirstItem(item: integer); - procedure UpdateScrollBar; - procedure FollowFocus; - function ListHeight: TfpgCoord; - function ScrollBarWidth: TfpgCoord; - function PageLength: integer; - procedure ScrollBarMove(Sender: TObject; position : integer); - procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); virtual; - procedure DoChange; - procedure DoSelect; - procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed : boolean); override; - procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; - procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; - procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; - procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; - procedure HandleShow; override; - procedure HandlePaint; override; - property PopupFrame: boolean read FPopupFrame write SetPopupFrame; - property HotTrack: boolean read FHotTrack write FHotTrack; - property FocusItem: integer read FFocusItem write SetFocusItem; - property FontDesc: string read GetFontDesc write SetFontDesc; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure Update; - function ItemCount: integer; virtual; - function RowHeight: integer; virtual; - property Font: TfpgFont read FFont; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - property OnSelect: TNotifyEvent read FOnSelect write FOnSelect; - end; - - - // Listbox containg strings - the normal listbox as we know it. Used by - // component developers. - TfpgTextListBox = class(TfpgBaseListBox) - protected - FItems: TStrings; - FInternalItems: TStrings; - procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); override; - property Items: TStrings read FItems; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - function ItemCount: integer; override; - function Text: string; - end; - - - // The standard strings listbox we will actually use in a GUI. - TfpgListBox = class(TfpgTextListBox) - published - property FocusItem; - property FontDesc; - property HotTrack; - property Items; - property PopupFrame; - end; - - -implementation - -type - // used to access protected properties - TfpgScrollbarFriend = class(TfpgScrollbar) - end; - - // custom stringlist that will notify listbox of item changes - TfpgListBoxStrings = class(TStringList) - protected - ListBox: TfpgTextListBox; - procedure SetUpdateState(Updating: Boolean); override; - public - constructor Create(AListBox: TfpgTextListBox); - function Add(const s: String): Integer; override; - end; - -{ TfpgListBoxStrings } - -procedure TfpgListBoxStrings.SetUpdateState(Updating: Boolean); -begin - inherited SetUpdateState(Updating); - // do nothing extra for now -end; - -constructor TfpgListBoxStrings.Create(AListBox: TfpgTextListBox); -begin - inherited Create; - ListBox := AListBox; -end; - -function TfpgListBoxStrings.Add(const s: String): Integer; -var - ItemWidth: Integer; -begin - Result := inherited Add(s); - if Assigned(ListBox) and (ListBox.HasHandle) then - begin - ItemWidth := ListBox.Font.TextWidth(s) + 4; -// if ItemWidth > ListBox.FMaxItemWidth then -// ListBox.FMaxItemWidth := ItemWidth; - ListBox.UpdateScrollBar; - end; -end; - - -{ TfpgBaseListBox } - -function TfpgBaseListBox.GetFontDesc: string; -begin - result := FFont.FontDesc; -end; - -procedure TfpgBaseListBox.SetFocusItem(const AValue: integer); -begin - if FFocusItem = AValue then - Exit; //==> - FFocusItem := AValue; - FollowFocus; - UpdateScrollbar; - RePaint; -end; - -procedure TfpgBaseListBox.SetFontDesc(const AValue: string); -begin - FFont.Free; - FFont := fpgGetFont(AValue); - RePaint; -end; - -procedure TfpgBaseListBox.SetPopupFrame(const AValue: boolean); -begin - if FPopupFrame = AValue then - Exit; //==> - FPopupFrame := AValue; - RePaint; -end; - -procedure TfpgBaseListBox.UpdateScrollbarCoords; -var - HWidth: integer; - VHeight: integer; -begin - VHeight := Height - 4; - HWidth := Width - 4; - - if FScrollBar.Visible then Dec(HWidth, FScrollBar.Width); - - FScrollBar.Top := 2; - FScrollBar.Left := Width - FScrollBar.Width - 2; - FScrollBar.Height := VHeight; - FScrollBar.UpdateWindowPosition; -end; - -procedure TfpgBaseListBox.SetFirstItem(item: integer); -begin - FFirstItem := item; - UpdateScrollBar; -end; - -procedure TfpgBaseListBox.UpdateScrollBar; -var - pn : integer; -begin - pn := PageLength; - FScrollBar.Visible := PageLength < ItemCount; - - if FScrollBar.Visible then - begin - FScrollBar.Min := 1; - if ItemCount <> 0 then - FScrollBar.SliderSize := pn / ItemCount - else - FScrollBar.SliderSize := 1; - FScrollBar.Max := ItemCount-pn+1; - FScrollBar.Position := FFirstItem; - if FScrollBar.WinHandle > 0 then - TfpgScrollbarFriend(FScrollBar).RePaint; - end; -end; - -procedure TfpgBaseListBox.FollowFocus; -var - n : integer; - h : TfpgCoord; -begin - if FFocusItem < FFirstItem then - begin - FFirstItem := FFocusItem; - UpdateScrollBar; - end - else - begin - h := 0; - for n := FFocusItem downto FFirstItem do - begin - h := h + RowHeight; - if h > ListHeight then - begin - FFirstItem := n+1; - UpdateScrollBar; - break; - end; - end; - end; -end; - -function TfpgBaseListBox.ListHeight: TfpgCoord; -begin - result := height - (2*FMargin); -end; - -function TfpgBaseListBox.ScrollBarWidth: TfpgCoord; -begin - if FScrollBar.Visible then - result := FScrollBar.Width - else - result := 0; -end; - -function TfpgBaseListBox.PageLength: integer; -begin - result := Trunc(ListHeight / RowHeight); -end; - -procedure TfpgBaseListBox.ScrollBarMove(Sender: TObject; position: integer); -begin - FFirstItem := position; - Repaint; -end; - -procedure TfpgBaseListBox.DoChange; -begin - if Assigned(FOnChange) then - FOnChange(self); -end; - -procedure TfpgBaseListBox.DoSelect; -begin - if Assigned(FOnSelect) then - FOnSelect(self); -end; - -procedure TfpgBaseListBox.HandleKeyPress(var keycode: word; - var shiftstate: TShiftState; var consumed: boolean); -begin - consumed := true; - - case keycode of - keyUp: - begin - if FFocusItem > 1 then - begin - dec(FFocusItem); - FollowFocus; - RePaint; - DoChange; - end; - end; - - keyDown: - begin - if FFocusItem < ItemCount then - begin - inc(FFocusItem); - FollowFocus; - RePaint; - DoChange; - end; - end; - - keyPageUp: - begin - dec(FFocusItem,PageLength); - if FFocusItem < 1 then FFocusItem := 1; - FollowFocus; - RePaint; - DoChange; - end; - - keyPageDown: - begin - inc(FFocusItem,PageLength); - if FFocusItem > ItemCount then FFocusItem := ItemCount; - FollowFocus; - RePaint; - DoChange; - end; - - keyHome: - begin - FFocusItem := 1; - FollowFocus; - RePaint; - DoChange; - end; - - keyEnd: - begin - FFocusItem := ItemCount; - FollowFocus; - RePaint; - DoChange; - end; - - keyReturn: - begin - DoSelect; - consumed := false; // to allow the forms to detect it - end; - else - begin - consumed := false; - end; - end; - inherited HandleKeyPress(keycode, shiftstate, consumed); -end; - -procedure TfpgBaseListBox.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); -begin - inherited HandleLMouseDown(x, y, shiftstate); - - if ItemCount < 1 then - Exit; //==> - - FFocusItem := FFirstItem + Trunc((y - FMargin) / RowHeight); - if FFocusItem > ItemCount then - FFocusItem := ItemCount; - - FollowFocus; - FMouseDragging := true; - Repaint; - DoChange; -end; - -procedure TfpgBaseListBox.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); -begin - inherited HandleLMouseUp(x, y, shiftstate); - if ItemCount < 1 then - Exit; //==> - - FMouseDragging := False; - - FFocusItem := FFirstItem + Trunc((y - FMargin) / RowHeight); - if FFocusItem > ItemCount then - FFocusItem := ItemCount; - - FollowFocus; - Repaint; - DoChange; - DoSelect; -end; - -procedure TfpgBaseListBox.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); -var - oldf: integer; -begin - inherited HandleMouseMove(x, y, btnstate, shiftstate); - - if ItemCount < 1 then - Exit; //==> - - if ((not FMouseDragging) or (btnstate and 1 = 0)) and (not HotTrack) then - Exit; //==> - - oldf := FFocusItem; - - FFocusItem := FFirstItem + Trunc((y - FMargin) / RowHeight); - if FFocusItem > ItemCount then - FFocusItem := ItemCount; - - if oldf <> FFocusItem then - begin - FollowFocus; - Repaint; - end; -end; - -procedure TfpgBaseListBox.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); -var - pfi: integer; -begin - pfi := FFirstItem; - if delta > 0 then // scroll down - FFirstItem := FFirstItem + abs(delta) - else // scroll up - FFirstItem := FFirstItem - abs(delta); - - if FFirstItem + PageLength > ItemCount then - FFirstItem := ItemCount - PageLength + 1; - if FFirstItem < 1 then - FFirstItem := 1; - if pfi <> FFirstItem then - begin - UpdateScrollBar; - Repaint; - end; -end; - -procedure TfpgBaseListBox.HandleShow; -begin - UpdateScrollBarCoords; - UpdateScrollBar; - inherited HandleShow; -end; - -procedure TfpgBaseListBox.HandlePaint; -var - n: integer; - r: TfpgRect; -begin - Canvas.BeginDraw; - inherited HandlePaint; - - Canvas.ClearClipRect; - - if popupframe then - begin - Canvas.SetColor(clWidgetFrame); - Canvas.DrawRectangle(0, 0, Width, Height); - r.SetRect(1, 1, Width - 2, Height - 2); - end - else - begin - Canvas.DrawControlFrame(0, 0, Width, Height); - r.SetRect(2, 2, Width-4, Height-4); - end; - - Canvas.SetClipRect(r); - Canvas.SetColor(FBackgroundColor); - Canvas.FillRectangle(r); - Canvas.SetFont(FFont); - - r.SetRect(FMargin, FMargin, Width-ScrollBarWidth-FMargin-2, Height-(2*FMargin)); - canvas.SetClipRect(r); - - r.Height := RowHeight; - - for n := FFirstItem to ItemCount do - begin - if n = FFocusItem then - begin - if FFocused then - begin - Canvas.SetColor(clSelection); - Canvas.SetTextColor(clSelectionText); - end - else - begin - Canvas.SetColor(clInactiveSel); - Canvas.SetTextColor(clInactiveSelText); - end; - end - else - begin - Canvas.SetColor(FBackgroundColor); - Canvas.SetTextColor(clText1); - end; - Canvas.FillRectangle(r); - - DrawItem(n,r,0); - r.Top := r.Top + r.Height; - - if r.Top >= self.Height then - break; - end; - - // clearing after the last row - if r.Top <= Height then - begin - canvas.SetColor(FBackgroundColor); - r.SetBottom(Height - fmargin); - Canvas.FillRectangle(r); - end; - - Canvas.EndDraw; -end; - -constructor TfpgBaseListBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FFont := fpgGetFont('#List'); - FBackgroundColor := clListBox; - - FScrollBar := TfpgScrollBar.Create(self); - FScrollBar.OnScroll := @ScrollBarMove; - - FFocusable := True; - FFocusItem := 1; - FFirstItem := 1; - FWidth := 80; - FHeight := 80; - FMargin := 2; - FMouseDragging := False; - FPopupFrame := False; - FHotTrack := False; - - FOnChange := nil; - FOnSelect := nil; -end; - -destructor TfpgBaseListBox.Destroy; -begin - FFont.Free; - inherited Destroy; -end; - -procedure TfpgBaseListBox.Update; -begin - FFirstItem := 1; - FFocusItem := 1; - UpdateScrollBar; - Repaint; -end; - -function TfpgBaseListBox.ItemCount: integer; -begin - {$Note This is wrong!!} - result := 17; -end; - -function TfpgBaseListBox.RowHeight: integer; -begin - result := FFont.Height+2; -end; - -procedure TfpgBaseListBox.DrawItem(num: integer; rect: TfpgRect; flags: integer); -var - s: string; -begin - s := 'Item' + IntToStr(num); - Canvas.DrawString(rect.left+2, rect.top+1,s); -end; - -{ TfpgTextListBox } - -procedure TfpgTextListBox.DrawItem(num: integer; rect: TfpgRect; flags: integer); -begin - Canvas.DrawString(rect.left+2, rect.top+1, FItems.Strings[num-1]); -end; - -constructor TfpgTextListBox.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FItems := TfpgListBoxStrings.Create(self); - FFocusItem := -1; -end; - -destructor TfpgTextListBox.Destroy; -begin - FItems.Free; - FInternalItems.Free; - inherited Destroy; -end; - -function TfpgTextListBox.ItemCount: integer; -begin - result := FItems.Count; -end; - -function TfpgTextListBox.Text: string; -begin - if (FocusItem > 0) and (FocusItem <= FItems.Count) then - result := FItems.Strings[FocusItem-1] - else - result := ''; -end; - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_memo.pas b/prototypes/fpgui2/source/gui/gui_memo.pas deleted file mode 100644 index 8736ec6d..00000000 --- a/prototypes/fpgui2/source/gui/gui_memo.pas +++ /dev/null @@ -1,1272 +0,0 @@ -unit gui_memo; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - gfxbase, - fpgfx, - gfx_widget, - gui_scrollbar; - -type - - { TfpgMemo } - - TfpgMemo = class(TfpgWidget) - private - FLines: TStringList; - FMaxLength: integer; - FCursorPos: integer; - FCursorLine: integer; - FOnChange: TNotifyEvent; - FSideMargin: integer; - FSelStartLine: integer; - FSelEndLine: integer; - FSelStartPos: integer; - FSelEndPos: integer; - FSelecting: boolean; - FMouseDragging: boolean; - FMouseDragPos: integer; - FFont: TfpgFont; - FBackgroundColor: TfpgColor; - FDrawOffset: integer; - FLineHeight: integer; - FFirstLine: integer; - FVScrollBar: TfpgScrollBar; - FHScrollBar: TfpgScrollBar; - FWrapping: boolean; - FLongestLineWidth: TfpgCoord; - function GetFontDesc: string; - procedure SetFontDesc(const AValue: string); - procedure RecalcLongestLine; - procedure DeleteSelection; - procedure DoCopy; - procedure DoPaste; - procedure AdjustCursor; - function LineCount: integer; - function GetLineText(linenum: integer): string; - procedure SetLineText(linenum: integer; Value: string); - function GetCursorX: integer; - procedure SetCPByX(x: integer); - function CurrentLine: string; - function VisibleLines: integer; - function VisibleWidth: integer; - procedure VScrollBarMove(Sender: TObject; position: integer); - procedure HScrollBarMove(Sender: TObject; position: integer); - procedure SetText(const AValue: string); - function GetText: string; - procedure SetCursorLine(aValue: integer); - procedure UpdateScrollBarCoords; - protected - procedure HandleKeyChar(var AText: string; var shiftstate: TShiftState; var consumed: boolean); override; - procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; - procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; - procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; - procedure HandleResize(dwidth, dheight: integer); override; - procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; - procedure HandlePaint; override; - procedure HandleShow; override; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure UpdateScrollBar; - function SelectionText: string; - property LineHeight: integer read FLineHeight; - property CursorLine: integer read FCursorLine write SetCursorLine; - property Text: string read GetText write SetText; - property Font: TfpgFont read FFont; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - published - property Lines: TStringList read FLines; - property FontDesc: string read GetFontDesc write SetFontDesc; - end; - - -implementation - -uses - gfx_UTF8utils; - -{ TfpgMemo } - -procedure TfpgMemo.SetCursorLine(aValue: integer); -var - i: integer; - MaxLine: integer; - yp: integer; -begin - if (aValue < 1) or (aValue = FCursorLine) then - Exit; // wrong value - if aValue < FFirstLine then - begin - FFirstLine := aValue; // moves the selected line to the top of the displayed rectangle - FCursorLine := aValue; - FCursorPos := 0; - RePaint; - Exit; - end; - yp := 2; - MaxLine := 0; - for i := FFirstLine to LineCount do - begin - yp := yp + LineHeight; - if yp > Height then - begin - MaxLine := i - 1; - break; - end; - end; - if MaxLine < aValue then - begin - FFirstLine := aValue; - FCursorLine := aValue; - FCursorPos := 0; - RePaint; - Exit; - end - else - begin - FCursorLine := aValue; - FCursorPos := 0; - RePaint; - Exit; - end; -end; - -procedure TfpgMemo.UpdateScrollBarCoords; -var - HWidth: integer; - VHeight: integer; -begin - VHeight := Height - 4; - HWidth := Width - 4; - - if FVScrollBar.Visible then Dec(HWidth, FVScrollBar.Width); - if FHScrollBar.Visible then Dec(VHeight, FHScrollBar.Height); - - FHScrollBar.Top := Height -FHScrollBar.Height - 2; - FHScrollBar.Left := 2; - FHScrollBar.Width := HWidth; - - FVScrollBar.Top := 2; - FVScrollBar.Left := Width - FVScrollBar.Width - 2; - FVScrollBar.Height := VHeight; - FVScrollBar.UpdateWindowPosition; - FHScrollBar.UpdateWindowPosition; -end; - -constructor TfpgMemo.Create(AOwner: TComponent); -begin - inherited; - Focusable := True; - FFont := fpgGetFont('#Edit1'); - FHeight := FFont.Height * 3 + 4; - FWidth := 120; - FLineHeight := FFont.Height + 2; - - FSelecting := False; - FSideMargin := 3; - FMaxLength := 0; - - FOnChange := nil; - - FLines := TStringList.Create; - FFirstLine := 1; - FCursorLine := 1; - - FCursorPos := 0; - FSelStartPos := FCursorPos; - FSelEndPos := 0; - FSelStartLine := 0; - FSelEndLine := 0; - - FBackgroundColor := clBoxColor; - - FDrawOffset := 0; - FMouseDragging := False; - - FVScrollBar := TfpgScrollBar.Create(self); - FVScrollBar.Orientation := orVertical; - FVScrollBar.OnScroll := @VScrollBarMove; - - FHScrollBar := TfpgScrollBar.Create(self); - FHScrollBar.Orientation := orHorizontal; - FHScrollBar.OnScroll := @HScrollBarMove; - FHScrollBar.ScrollStep := 5; - - FWrapping := False; -end; - -destructor TfpgMemo.Destroy; -begin - FLines.Free; - FFont.Free; - inherited Destroy; -end; - -procedure TfpgMemo.RecalcLongestLine; -var - n: integer; - lw: TfpgCoord; -begin - FLongestLineWidth := 0; - for n := 1 to LineCount do - begin - lw := FFont.TextWidth(getlinetext(n)); - if lw > FlongestLineWidth then - FlongestLineWidth := lw; - end; -end; - -function TfpgMemo.GetFontDesc: string; -begin - Result := FFont.FontDesc; -end; - -procedure TfpgMemo.DeleteSelection; -var - n: integer; - selsl: integer; - selsp: integer; - selel: integer; - selep: integer; - ls: string; - len: integer; - st: integer; -begin - if FSelEndLine < 1 then - Exit; - - if (FSelStartLine shl 16) + FSelStartPos <= (FSelEndLine shl 16) + FSelEndPos then - begin - selsl := FSelStartLine; - selsp := FSelStartPos; - selel := FSelEndLine; - selep := FSelEndPos; - end - else - begin - selel := FSelStartLine; - selep := FSelStartPos; - selsl := FSelEndLine; - selsp := FSelEndPos; - end; - - for n := selsl to selel do - begin - ls := GetLineText(n); - - if selsl < n then - st := 0 - else - st := selsp; - if selel > n then - len := UTF8Length(ls) - else - len := selep - st; - - Delete(ls, st + 1, len); - SetLineText(n, ls); - end; - - if selsl < selel then - begin - ls := GetlineText(selsl); - ls := ls + GetLineText(selel); - SetLineText(selsl, ls); - end; - - for n := selsl + 1 to selel do - FLines.Delete(selsl); - - FCursorPos := selsp; - FCursorLine := selsl; - FSelEndLine := 0; -end; - -procedure TfpgMemo.DoCopy; -var - n: integer; - selsl: integer; - selsp: integer; - selel: integer; - selep: integer; - ls: string; - len: integer; - st: integer; - s: string; -begin - if FSelEndLine < 1 then - Exit; - - if (FSelStartLine shl 16) + FSelStartPos <= (FSelEndLine shl 16) + FSelEndPos then - begin - selsl := FSelStartLine; - selsp := FSelStartPos; - selel := FSelEndLine; - selep := FSelEndPos; - end - else - begin - selel := FSelStartLine; - selep := FSelStartPos; - selsl := FSelEndLine; - selsp := FSelEndPos; - end; - - s := ''; - - for n := selsl to selel do - begin - if n > selsl then - s := s + #13#10; - - ls := GetLineText(n); - - if selsl < n then - st := 0 - else - st := selsp; - - if selel > n then - len := UTF8Length(ls) - else - len := selep - st; - - s := s + UTF8Copy(ls, st + 1, len); - end; - - //SetClipboardText(s); -end; - -procedure TfpgMemo.DoPaste; -var - s: string; - si: string; - si8: string; - lineend: string; - n: integer; - l: integer; - lcnt: integer; -begin - Exit; - (* - DeleteSelection; - s := GetClipboardText; - - si := UTF8Copy(CurrentLine,1,FCursorPos); - lineend := UTF8Copy(CurrentLine,FCursorPos+1, UTF8Length(CurrentLine)); - l := FCursorLine; - n := 1; - lcnt := 0; - si8 := ''; - while n <= length(s) do - begin - if (s[n] = #13) or (s[n] = #10) then - begin - if lcnt = 0 then SetLineText(l, si + si8) - else FLines.Insert(l-1, si + si8); - - si := ''; - si8 := ''; - inc(lcnt); - inc(l); - - // skip multibyte line end: - if (s[n]=#13) and (n < length(s)) and (s[n+1]=#10) then inc(n); - end - else - begin - si8 := si8 + s[n]; - end; - inc(n); - end; - - si := si + si8; - - FCursorPos := UTF8Length(si); - si := si + lineend; - - if lcnt = 0 then - begin - SetLineText(l, si) - end - else - begin - FLines.Insert(l-1, si); - FCursorLine := l; - end; - - AdjustCursor; - Repaint; -*) -end; - -procedure TfpgMemo.AdjustCursor; -var - tw: integer; -begin - // horizontal adjust - RecalcLongestLine; - tw := FFont.TextWidth(UTF8Copy(CurrentLine, 1, FCursorPos)); - - if tw - FDrawOffset > VisibleWidth - 2 then - FDrawOffset := tw - VisibleWidth + 2 - else if tw - FDrawOffset < 0 then - begin - FDrawOffset := tw; - if tw <> 0 then - Dec(FDrawOffset, 2); - end; - - // vertical adjust - - if FCursorLine < FFirstLine then - FFirstLine := FCursorLine; - if FCursorline - FFirstLine + 1 > VisibleLines then - FFirstLine := FCursorline - VisibleLines + 1; - - if FFirstLine + VisibleLines > LineCount then - begin - FFirstLine := LineCount - VisibleLines + 1; - if FFirstline < 1 then - FFirstLine := 1; - end; - - UpdateScrollbar; -end; - -procedure TfpgMemo.UpdateScrollBar; -var - vlines: integer; - vsbw, x: integer; - hsbwas: boolean; - vsbwas: boolean; - vsbvis: boolean; -begin - hsbwas := FHScrollBar.Visible; - vsbwas := FVScrollBar.Visible; - vlines := (Height - (FSideMargin shl 1)) div Lineheight; - vsbvis := (LineCount > vlines); - - if vsbvis then - vsbw := FVScrollBar.Width - else - vsbw := 0; - - FHScrollBar.Visible := FLongestLineWidth > (Width - vsbw - FSideMargin * 2) - 1; - - if FHScrollBar.Visible and not vsbvis then - begin - // recheck vertical scrollbar - vlines := (Height - (FSideMargin shl 1) - FHScrollBar.Height) div Lineheight; - vsbvis := (LineCount > vlines); - end; - - FVScrollBar.Visible := vsbvis; - - UpdateScrollBarCoords; - - if FHScrollBar.Visible then - begin - FHScrollBar.Min := 0; - FHScrollBar.Max := FLongestLineWidth - VisibleWidth - 1; - if (FLongestLineWidth <= 0) or (FLongestLineWidth <= VisibleWidth) then - FHScrollBar.SliderSize := 1 - else - FHScrollBar.SliderSize := VisibleWidth / FLongestLineWidth; - FHScrollBar.Position := FDrawOffset; - FHScrollBar.RepaintSlider; - end; - - if FVScrollBar.Visible then - begin - FVScrollBar.Min := 1; - FVScrollBar.SliderSize := VisibleLines / LineCount; - FVScrollBar.Max := LineCount - VisibleLines + 1; - FVScrollBar.Position := FFirstLine; - - FVScrollBar.RePaintSlider; - end; - - if (hsbwas <> FHScrollBar.Visible) or (vsbwas <> FVScrollBar.Visible) then - AdjustCursor; -end; - -function TfpgMemo.LineCount: integer; -begin - Result := FLines.Count; -end; - -function TfpgMemo.GetLineText(linenum: integer): string; -begin - if LineCount < 1 then - FLines.Add(''); - if (linenum >= 1) and (linenum <= LineCount) then - Result := FLines.Strings[linenum - 1] - else - Result := ''; -end; - -procedure TfpgMemo.SetFontDesc(const AValue: string); -begin - FFont.Free; - FFont := fpgGetFont(AValue); - RePaint; -end; - -procedure TfpgMemo.SetLineText(linenum: integer; Value: string); -begin - FLines.Strings[linenum - 1] := Value; -end; - -function TfpgMemo.GetCursorX: integer; -begin - Result := FFont.TextWidth(copy(CurrentLine, 1, FCursorPos)); -end; - -// Set cursor position by X -procedure TfpgMemo.SetCPByX(x: integer); -var - s: string; - n: integer; - cpx: integer; - cp: integer; - cx: integer; - ls: string; -begin - // searching the appropriate character position - ls := CurrentLine; - cpx := FFont.TextWidth(UTF8Copy(ls, 1, FCursorPos)); // + FDrawOffset + FSideMargin; - cp := FCursorPos; - if cp > UTF8Length(ls) then - cp := UTF8Length(ls); - - s := ''; - - for n := 0 to UTF8Length(ls) do - begin - cx := FFont.TextWidth(UTF8Copy(ls, 1, n)); // + FDrawOffset + FSideMargin; - if abs(cx - x) < abs(cpx - x) then - begin - cpx := cx; - cp := n; - end; - end; - - FCursorPos := cp; -end; - -function TfpgMemo.CurrentLine: string; -begin - Result := GetLineText(FCursorLine); -end; - -function TfpgMemo.VisibleLines: integer; -var - sh: integer; -begin - if FHScrollBar.Visible then - sh := 18 - else - sh := 0; - Result := (Height - (FSideMargin shl 1) - sh) div Lineheight; -end; - -function TfpgMemo.VisibleWidth: integer; -var - sw: integer; -begin - if FVScrollBar.Visible then - sw := FVScrollBar.Width - else - sw := 0; - Result := (Width - (FSideMargin shl 1) - sw); -end; - -procedure TfpgMemo.HandleShow; -begin - // FVScrollBar.SetDimensions(width-18,0,18,height); - // FHScrollBar.SetDimensions(0,height-18,width-18,18); - // FHScrollBar.Visible := false; - inherited HandleShow; - RecalcLongestLine; - UpdateScrollBar; - UpdateScrollBarCoords; -end; - -procedure TfpgMemo.VScrollBarMove(Sender: TObject; position: integer); -begin - if FFirstLine <> position then - begin - FFirstLine := position; - repaint; - end; -end; - -procedure TfpgMemo.HScrollBarMove(Sender: TObject; position: integer); -begin - if position <> FDrawOffset then - begin - FDrawOffset := position; - Repaint; - end; -end; - -procedure TfpgMemo.HandlePaint; -var - n: integer; - tw, tw2, st, len: integer; - yp: integer; - ls: string; - r: TfpgRect; - selsl, selsp, selel, selep: integer; -begin - Canvas.BeginDraw; - Canvas.ClearClipRect; - fpgStyle.DrawControlFrame(Canvas, 0, 0, Width, Height); - - r.Left := 2; - r.Top := 2; - r.Width := Width - 4; - r.Height := Height - 4; - Canvas.SetClipRect(r); - - if Enabled then - Canvas.SetColor(FBackgroundColor) - else - Canvas.SetColor(clWindowBackground); - - Canvas.FillRectAngle(2, 2, Width - 4, Height - 4); - Canvas.SetFont(FFont); - - if (FSelStartLine shl 16) + FSelStartPos <= (FSelEndLine shl 16) + FSelEndPos then - begin - selsl := FSelStartLine; - selsp := FSelStartPos; - selel := FSelEndLine; - selep := FSelEndPos; - end - else - begin - selel := FSelStartLine; - selep := FSelStartPos; - selsl := FSelEndLine; - selsp := FSelEndPos; - end; - - yp := 3; - for n := FFirstline to LineCount do - begin - ls := GetLineText(n); - Canvas.DrawString(-FDrawOffset + FSideMargin, yp, ls); - - if Focused then - begin - // drawing selection - if (FSelEndLine > 0) and (selsl <= n) and (selel >= n) then - begin - if selsl < n then - st := 0 - else - st := selsp; - if selel > n then - len := UTF8Length(ls) - else - len := selep - st; - - tw := FFont.TextWidth(UTF8Copy(ls, 1, st)); - tw2 := FFont.TextWidth(UTF8Copy(ls, 1, st + len)); - Canvas.XORFillRectangle(fpgColorToRGB(clSelection) xor $FFFFFF, -FDrawOffset + - FSideMargin + tw, yp, tw2 - tw, LineHeight); - end; - - //drawing cursor - if FCursorLine = n then - begin - // drawing cursor - tw := FFont.TextWidth(UTF8Copy(ls, 1, FCursorPos)); - fpgCaret.SetCaret(Canvas, -FDrawOffset + FSideMargin + tw, yp, 1, FFont.Height); - end; - - end; - - yp := yp + LineHeight; - - if yp > Height then - Break; - end; - - if not Focused then - fpgCaret.UnSetCaret(Canvas); - - if FHScrollBar.Visible and FVScrollBar.Visible then begin - Canvas.SetColor(clWindowBackground); - Canvas.FillRectangle(FHScrollBar.Left + FHScrollBar.Width, - FVScrollBar.Top + FVScrollBar.Height, - FVScrollBar.Width, FHScrollBar.Height); - end; - - Canvas.EndDraw; -end; - -procedure TfpgMemo.HandleKeyChar(var AText: string; var shiftstate: TShiftState; var consumed: boolean); -var - prevval: string; - s: string; - ls: string; -begin - inherited; - prevval := Text; - s := AText; - Consumed := False; -{ - Consumed := true; - case pgfCheckClipBoardKey(keycode, shiftstate) of - ckCopy: DoCopy; - ckPaste: DoPaste; - ckCut: //if FSelEndLine > 0 then - begin - DoCopy; - DeleteSelection; - end; - else - Consumed := false; - end; -} - - // Printable characters only - // Note: This is not UTF-8 compliant! - if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) then - begin - // printeable - //FText := FText + s; - - if (FMaxLength <= 0) or (UTF8Length(FLines.Text) < FMaxLength) then - begin - DeleteSelection; - ls := GetLineText(FCursorLine); - insert(s, ls, FCursorPos + 1); - SetLineText(FCursorLine, ls); - Inc(FCursorPos); - FSelStartPos := FCursorPos; - FSelStartLine := FCursorLine; - FSelEndLine := 0; - AdjustCursor; - end; - - consumed := True; - end; - - if prevval <> Text then - if Assigned(FOnChange) then - FOnChange(self); - - if consumed then - RePaint; -end; - -procedure TfpgMemo.HandleKeyPress(var keycode: word; - var shiftstate: TShiftState; var consumed: boolean); -var - cx: integer; - ls: string; - ls2: string; - - procedure StopSelection; - begin - FSelStartLine := FCursorLine; - FSelStartPos := FCursorPos; - FSelEndLine := 0; - end; - -begin - Consumed := False; - (* - Consumed := true; - case pgfCheckClipBoardKey(keycode, shiftstate) of - ckCopy: DoCopy; - ckPaste: DoPaste; - ckCut: //if FSelEndLine > 0 then - begin - DoCopy; - DeleteSelection; - end; - else - Consumed := false; - end; -*) - - if not Consumed then - begin - // checking for movement keys: - consumed := True; - FSelecting := (ssShift in shiftstate); - - case keycode of - keyLeft: - if FCursorPos > 0 then - begin - Dec(FCursorPos); - - if (ssCtrl in shiftstate) then - // word search... - (* - while (FCursorPos > 0) and not pgfIsAlphaNum(copy(CurrentLine,FCursorPos,1)) - do Dec(FCursorPos); - - while (FCursorPos > 0) and pgfIsAlphaNum(copy(CurrentLine,FCursorPos,1)) - do Dec(FCursorPos); - *); - - end;// left - - keyRight: - if FCursorPos < UTF8Length(CurrentLine) then - begin - Inc(FCursorPos); - - if (ssCtrl in shiftstate) then - // word search... - (* - while (FCursorPos < length(CurrentLine)) and pgfIsAlphaNum(copy(CurrentLine,FCursorPos+1,1)) - do Inc(FCursorPos); - - while (FCursorPos < length(CurrentLine)) and not pgfIsAlphaNum(copy(CurrentLine,FCursorPos+1,1)) - do Inc(FCursorPos); - *); - - end;// right - - keyUp: - begin // up - cx := GetCursorX; - if FCursorLine > 1 then - begin - Dec(FCursorline); - SetCPByX(cx); - end; - end; - - keyDown: - begin - cx := GetCursorX; - if FCursorLine < LineCount then - begin - Inc(FCursorline); - SetCPByX(cx); - end; - end; - - keyHome: - begin - if (ssCtrl in shiftstate) then - FCursorLine := 1; - FCursorPos := 0; - end; - - keyEnd: - begin - if (ssCtrl in shiftstate) then - FCursorLine := LineCount; - FCursorPos := UTF8Length(CurrentLine); - end; - - keyPageUp: - if FCursorLine > 1 then - begin - cx := GetCursorX; - Dec(FCursorLine, VisibleLines); - if FCursorLine < 1 then - FCursorLine := 1; - SetCPByX(cx); - end; - - keyPageDown: - begin - cx := GetCursorX; - if FCursorLine < LineCount then - begin - Inc(FCursorline, VisibleLines); - if FCursorLine > LineCount then - FCursorLine := LineCount; - SetCPByX(cx); - end; - end; - - else - Consumed := False; - end; - - if Consumed then - begin - AdjustCursor; - - if FSelecting then - begin - FSelEndPos := FCursorPos; - FSelEndLine := FCursorLine; - end - else - StopSelection; - end; - end; - - if not Consumed then - begin - consumed := True; - - case keycode of - keyReturn: - begin - ls := UTF8Copy(FLines[FCursorline - 1], 1, FCursorPos); - ls2 := UTF8Copy(FLines[FCursorline - 1], FCursorPos + 1, UTF8Length(FLines[FCursorline - 1])); - FLines.Insert(FCursorLine - 1, ls); - Inc(FCursorLine); - SetLineText(FCursorLine, ls2); - FCursorPos := 0; - end; - keyBackSpace: - if FCursorPos > 0 then - begin - ls := GetLineText(FCursorLine); - Delete(ls, FCursorPos, 1); - SetLineText(FCursorLine, ls); - Dec(FCursorPos); - end - else if FCursorLine > 1 then - begin - ls := CurrentLine; - FLines.Delete(FCursorLine - 1); - Dec(FCursorLine); - FCursorPos := UTF8Length(FLines.Strings[FCursorLine - 1]); - FLines.Strings[FCursorLine - 1] := FLines.Strings[FCursorLine - 1] + ls; - end; - - keyDelete: - begin - ls := GetLineText(FCursorLine); - if FSelEndLine > 0 then - DeleteSelection - else if FCursorPos < UTF8Length(ls) then - begin - Delete(ls, FCursorPos + 1, 1); - SetLineText(FCursorLine, ls); - end - else if FCursorLine < LineCount then - begin - ls2 := FLines.Strings[FCursorLine]; - FLines.Delete(FCursorLine); - FLines.Strings[FCursorLine - 1] := ls + ls2; - end; - end; - else - consumed := False; - end; - - if Consumed then - begin - StopSelection; - AdjustCursor; - end; - end; - - if consumed then - RePaint - else - inherited; -end; - -procedure TfpgMemo.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); -var - s: string; - n: integer; - cpx: integer; - cp: integer; - cx: integer; - lnum: integer; - ls: string; -begin - inherited HandleLMouseDown(x, y, shiftstate); - - // searching the appropriate character position - lnum := FFirstLine + (y - FSideMargin) div LineHeight; - if lnum > LineCount then - lnum := LineCount; - - ls := GetLineText(lnum); - cpx := FFont.TextWidth(UTF8Copy(ls, 1, FCursorPos)) - FDrawOffset + FSideMargin; - cp := FCursorPos; - - s := ''; - - for n := 0 to UTF8Length(ls) do - begin - cx := FFont.TextWidth(UTF8Copy(ls, 1, n)) - FDrawOffset + FSideMargin; - if abs(cx - x) < abs(cpx - x) then - begin - cpx := cx; - cp := n; - end; - end; - - FMouseDragging := True; - FMouseDragPos := cp; - FCursorPos := cp; - FCursorLine := lnum; - - if (ssShift in shiftstate) then - begin - FSelEndLine := lnum; - FSelEndpos := cp; - end - else - begin - FSelStartLine := lnum; - FSelStartPos := cp; - FSelEndLine := 0; - end; - Repaint; -end; - -procedure TfpgMemo.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); -var - s: string; - n: integer; - cpx: integer; - cp: integer; - cx: integer; - lnum: integer; - ls: string; -begin - if not FMouseDragging or ((btnstate and 1) = 0) then - begin - FMouseDragging := False; - Exit; - end; - - // searching the appropriate character position - lnum := FFirstLine + (y - FSideMargin) div LineHeight; - if lnum > LineCount then - lnum := LineCount; - - ls := GetLineText(lnum); - cpx := FFont.TextWidth(UTF8Copy(ls, 1, FCursorPos)) - FDrawOffset + FSideMargin; - cp := FCursorPos; - s := ''; - - for n := 0 to UTF8Length(ls) do - begin - cx := FFont.TextWidth(UTF8Copy(ls, 1, n)) - FDrawOffset + FSideMargin; - if abs(cx - x) < abs(cpx - x) then - begin - cpx := cx; - cp := n; - end; - end; - - if (cp <> FCursorPos) or (lnum <> FCursorLine) then - begin - FCursorLine := lnum; - FSelEndLine := lnum; - FSelEndPos := cp; - FCursorPos := cp; - Repaint; - end; - - - // searching the appropriate character position - { - cpx := FFont.TextWidth16(copy16(FText,1,FCursorPos)) + FDrawOffset + FSideMargin; - cp := FCursorPos; - - s := ''; - - for n := 0 to Length16(Text) do - begin - cx := FFont.TextWidth16(copy16(Text,1,n)) + FDrawOffset + FSideMargin; - if abs(cx - x) < abs(cpx - x) then - begin - cpx := cx; - cp := n; - end; - end; - - //FMouseDragPos := cp; - FSelOffset := cp-FSelStart; - if FCursorPos <> cp then - begin - FCursorPos := cp; - Repaint; - end; -} -end; - -(* -procedure TfpgMemo.HandleWindowScroll(direction, amount: integer); -var - pfl, pdo : integer; -begin - inherited HandleWindowScroll(direction, amount); - - pfl := FFirstLine; - pdo := FDrawOffset; - - if direction = 0 then - begin - dec(FFirstLine, amount); - end; - if direction = 1 then - begin - inc(FFirstLine, amount); - end; - if FFirstLine > LineCount - VisibleLines + 1 then FFirstLine := LineCount - VisibleLines + 1; - if FFirstLine < 1 then FFirstLine := 1; - - if FHScrollBar.Visible then - begin - if Direction = 2 then - begin - dec(FDrawOffset, amount*16); - end; - if Direction = 3 then - begin - inc(FDrawOffset, amount*16); - end; - - if FDrawOffset > FHScrollBar.Max then FDrawOffset := FHScrollBar.Max; - if FDrawOffset < 0 then FDrawOffset := 0; - end; - - if (pfl <> FFirstLine) or (pdo <> FDrawOffset) then - begin - UpdateScrollBar; - Repaint; - end; - -end; -*) - -procedure TfpgMemo.HandleResize(dwidth, dheight: integer); -begin - inherited HandleResize(dwidth, dheight); - - //UpdateScrollBarCoords; - UpdateScrollBar; -end; - -procedure TfpgMemo.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; - delta: smallint); -var - pfl, pdo : integer; -begin - inherited HandleMouseScroll(x, y, shiftstate, delta); - -// inherited HandleWindowScroll(direction, amount); - - pfl := FFirstLine; - pdo := FDrawOffset; - - if delta < 0 then - dec(FFirstLine, abs(delta)) // scroll up - else - inc(FFirstLine, abs(delta)); // scroll down - - if FFirstLine > LineCount - VisibleLines + 1 then - FFirstLine := LineCount - VisibleLines + 1; - if FFirstLine < 1 then - FFirstLine := 1; - - if FHScrollBar.Visible then - begin - if FDrawOffset > FHScrollBar.Max then - FDrawOffset := FHScrollBar.Max; - if FDrawOffset < 0 then - FDrawOffset := 0; - end; - - if (pfl <> FFirstLine) or (pdo <> FDrawOffset) then - begin - UpdateScrollBar; - Repaint; - end; -end; - -function TfpgMemo.SelectionText: string; -begin - { - if FSelOffset <> 0 then - begin - if FSelOffset < 0 then - begin - Result := Copy16(FText,1+FSelStart + FSelOffset,-FSelOffset); - end - else - begin - result := Copy16(FText,1+FSelStart,FSelOffset); - end; - end - else Result := ''; -} -end; - -function TfpgMemo.GetText: string; -var - n: integer; - s: string; -begin - s := ''; - for n := 1 to LineCount do - begin - if n > 1 then - s := s + #13#10; - s := s + GetLineText(n); - end; - Result := s; -end; - -procedure TfpgMemo.SetText(const AValue: string); -var - n: integer; - c: string[2]; - s: string; -begin - FLines.Clear; - s := ''; - n := 1; - while n <= UTF8Length(AValue) do - begin - c := UTF8Copy(AValue, n, 1); - if (c[1] = #13) or (c[1] = #10) then - begin - FLines.Add(s); - s := ''; - c := UTF8Copy(AValue, n + 1, 1); - if c[1] = #10 then - Inc(n); - end - else - s := s + c; - Inc(n); - end; - - if s <> '' then - FLines.Add(s); - - FDrawOffset := 0; - FCursorPos := 0; - FCursorLine := 1; - FSelStartLine := FCursorLine; - FSelStartPos := FCursorPos; - FSelEndLine := 0; - - AdjustCursor; - Repaint; -end; - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_popupwindow.pas b/prototypes/fpgui2/source/gui/gui_popupwindow.pas deleted file mode 100644 index 3757aab6..00000000 --- a/prototypes/fpgui2/source/gui/gui_popupwindow.pas +++ /dev/null @@ -1,14 +0,0 @@ -unit gui_popupwindow; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils; - -implementation - -end. - diff --git a/prototypes/fpgui2/source/gui/gui_scrollbar.pas b/prototypes/fpgui2/source/gui/gui_scrollbar.pas deleted file mode 100644 index 325dce0d..00000000 --- a/prototypes/fpgui2/source/gui/gui_scrollbar.pas +++ /dev/null @@ -1,355 +0,0 @@ -unit gui_scrollbar; - -{$mode objfpc}{$H+} - -{ - TODO: - * Set slider button to minimum length (default setting) - * Create property to enable dynamic sizing of slider button length. - * Paint scroll area between arrow buttons and slider button a different - color on click. -} - -interface - -uses - Classes, - SysUtils, - gfxbase, - fpgfx, - gfx_widget; - -type - TScrollNotifyEvent = procedure(Sender: TObject; position: integer) of object; - - { TfpgScrollBar } - - TfpgScrollBar = class(TfpgWidget) - private - FMax: integer; - FMin: integer; - FOnScroll: TScrollNotifyEvent; - FPosition: integer; - FScrollStep: integer; - protected - FSliderPos: TfpgCoord; - FSliderLength: TfpgCoord; - FSliderDragging: boolean; - FStartBtnPressed, - FEndBtnPressed: Boolean; - FSliderDragPos: TfpgCoord; - FSliderDragStart: TfpgCoord; - FScrollTimer: TfpgTimer; - FActiveButtonRect: TRect; - FMousePosition: TPoint; - procedure ScrollTimer(Sender: TObject); - procedure DrawButton(x, y, w, h: TfpgCoord; const imgname: string; Pressed: Boolean = False); - procedure DrawSlider(recalc: boolean); - procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; - procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; - procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; - procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; - procedure HandlePaint; override; - procedure PositionChange(d: integer); - public - Orientation: TOrientation; - SliderSize: double; // 0-1 - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure RepaintSlider; - property Position: integer read FPosition write FPosition default 10; - property ScrollStep: integer read FScrollStep write FScrollStep default 1; - property Min: integer read FMin write FMin default 0; - property Max: integer read FMax write FMax default 100; - property OnScroll: TScrollNotifyEvent read FOnScroll write FOnScroll; - end; - - -implementation - -{ TfpgScrollBar } - -constructor TfpgScrollBar.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FScrollTimer := TfpgTimer.Create(500); - FScrollTimer.Enabled := False; - FScrollTimer.OnTimer := @ScrollTimer; - Orientation := orVertical; - FMin := 0; - FMax := 100; - FPosition := 10; - SliderSize := 0.5; - FOnScroll := nil; - FSliderPos := 0; - FSliderDragging := False; - FSliderLength := 10; - FScrollStep := 1; -end; - -destructor TfpgScrollBar.Destroy; -begin - FScrollTimer.Free; - inherited Destroy; -end; - -procedure TfpgScrollBar.HandlePaint; -begin - Canvas.BeginDraw; - - if Orientation = orVertical then - begin - DrawButton(0, 0, Width, Width, 'sys.sb.up' ,FStartBtnPressed); - DrawButton(0, Height - Width, Width, Width, 'sys.sb.down', FEndBtnPressed); - end - else - begin - DrawButton(0, 0, Height, Height, 'sys.sb.left', FStartBtnPressed); - DrawButton(Width - Height, 0, Height, Height, 'sys.sb.right', FEndBtnPressed); - end; - - DrawSlider(True); - Canvas.EndDraw; -end; - -procedure TfpgScrollBar.RepaintSlider; -begin - if not HasHandle then - Exit; //==> - DrawSlider(True); -end; - -procedure TfpgScrollBar.ScrollTimer(Sender: TObject); -begin - FScrollTimer.Interval := 25; - if (FMousePosition.X < FActiveButtonRect.Right) - and (FMousePosition.X > FActiveButtonRect.Left) - and (FMousePosition.Y < FActiveButtonRect.Bottom) - and (FMousePosition.Y > FActiveButtonRect.Top) then - begin - if FStartBtnPressed then - PositionChange(-FScrollStep); - if FEndBtnPressed then - PositionChange(FScrollStep); - end - else - FScrollTimer.Enabled := False; -end; - -procedure TfpgScrollBar.DrawButton(x, y, w, h: TfpgCoord; const imgname: string; Pressed: Boolean = False); -var - img: TfpgImage; -begin - if Pressed then - Canvas.DrawButtonFace(x, y, w, h, [btnIsEmbedded, btnIsPressed]) - else - Canvas.DrawButtonFace(x, y, w, h, [btnIsEmbedded]); - Canvas.SetColor(clText1); - img := fpgImages.GetImage(imgname); - if img <> nil then - Canvas.DrawImage(x + w div 2 - (img.Width div 2), y + h div 2 - (img.Height div 2), img); -end; - -procedure TfpgScrollBar.DrawSlider(recalc: boolean); -var - area: TfpgCoord; - mm: TfpgCoord; - rpr: TfpgRect; -begin - Canvas.BeginDraw; - - if SliderSize > 1 then - SliderSize := 1; - - Canvas.SetColor(clScrollBar); - - if Orientation = orVertical then - begin - Canvas.FillRectangle(0, Width, Width, Height - Width - Width); - area := Height - (Width shl 1); - end - else - begin - Canvas.FillRectangle(Height, 0, Width - Height - Height, Height); - area := Width - (Height shl 1); - end; - - if recalc then - begin - if FPosition > FMax then - FPosition := FMax; - if FPosition < FMin then - FPosition := FMin; - - FSliderLength := Trunc(area * SliderSize); - if FSliderLength < 20 then - FSliderLength := 20; - area := area - FSliderLength; - mm := FMax - FMin; - if mm = 0 then - FSliderPos := 0 - else - FSliderPos := Trunc(area * ((FPosition - FMin) / mm)); - end; - - if Orientation = orVertical then - begin - Canvas.DrawButtonFace(0, Width + FSliderPos, Width, FSliderLength, [btnIsEmbedded]); - Canvas.EndDraw(0, Width, Width, Height - Width - Width); - end - else - begin - Canvas.DrawButtonFace(Height + FSliderPos, 0, FSliderLength, Height, [btnIsEmbedded]); - Canvas.EndDraw(Height, 0, Width - Height - Height, Height); - end; -end; - -procedure TfpgScrollBar.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); -begin - inherited; - - if Orientation = orVertical then - begin - if y <= Width then - begin - PositionChange(-FScrollStep); - FStartBtnPressed := True; - FActiveButtonRect := Rect(0, 0, Width, Width); - end - else if y >= Height - Width then - begin - PositionChange(FScrollStep); - FEndBtnPressed := True; - FActiveButtonRect := Rect(0,Height-Width, Width, Height); - end - else if (y >= Width + FSliderPos) and (y <= Width + FSliderPos + FSliderLength) then - begin - FSliderDragging := True; - FSliderDragPos := y; - end; - end - else - begin - if x <= Height then - begin - PositionChange(-FScrollStep); - FStartBtnPressed := True; - FActiveButtonRect := Rect(0, 0, Height, Height); - end - else if x >= Width - Height then - begin - PositionChange(FScrollStep); - FEndBtnPressed := True; - FActiveButtonRect := Rect(Width-Height, 0, Width, Height); - end - else if (x >= Height + FSliderPos) and (x <= Height + FSliderPos + FSliderLength) then - begin - FSliderDragging := True; - FSliderDragPos := x; - end; - end; - - if FSliderDragging then - begin - FSliderDragStart := FSliderPos; - DrawSlider(False); - end - else if FStartBtnPressed or FEndBtnPressed then - begin - FScrollTimer.Interval := 500; - FScrollTimer.Enabled := True; - - HandlePaint; - end; -end; - -procedure TfpgScrollBar.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); -var - WasPressed: Boolean; -begin - inherited; - WasPressed := FStartBtnPressed or FEndBtnPressed; - FScrollTimer.Enabled := False; - FStartBtnPressed := False; - FEndBtnPressed := False; - FSliderDragging := False; - if WasPressed then HandlePaint; -end; - -procedure TfpgScrollBar.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); -var - d: integer; - area: integer; - newp: integer; - ppos: integer; -begin - inherited HandleMouseMove(x, y, btnstate, shiftstate); - - FMousePosition.X := x; - FMousePosition.Y := y; - - if (not FSliderDragging) or ((btnstate and MOUSE_LEFT) = 0) then - begin - FSliderDragging := False; - Exit; - end; - - if Orientation = orVertical then - begin - d := y - FSliderDragPos; - area := Height - (Width shl 1) - FSliderLength; - end - else - begin - d := x - FSliderDragPos; - area := Width - (Height shl 1) - FSliderLength; - end; - - ppos := FSliderPos; - FSliderPos := FSliderDragStart + d; - - if FSliderPos < 0 then - FSliderPos := 0; - if FSliderPos > area then - FSliderPos := area; - - if ppos <> FSliderPos then - DrawSlider(False); - - if area <> 0 then - newp := FMin + Trunc((FMax - FMin) * FSliderPos / area) - else - newp := FMin; - - if newp <> FPosition then - begin - FPosition := newp; - if Assigned(FOnScroll) then - FOnScroll(self, FPosition); - end; -end; - -procedure TfpgScrollBar.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; - delta: smallint); -begin - inherited HandleMouseScroll(x, y, shiftstate, delta); - if delta < 0 then PositionChange(-FScrollStep); - if delta > 0 then PositionChange( FScrollStep); -end; - -procedure TfpgScrollBar.PositionChange(d: integer); -begin - FPosition := FPosition + d; - if FPosition < FMin then - FPosition := FMin; - if FPosition > FMax then - FPosition := FMax; - - DrawSlider(True); - - if Assigned(FOnScroll) then - FOnScroll(self, FPosition); -end; - -end. - diff --git a/prototypes/multihandle/gui2Base.pas b/prototypes/multihandle/gui2Base.pas deleted file mode 100644 index fe25dbf9..00000000 --- a/prototypes/multihandle/gui2Base.pas +++ /dev/null @@ -1,442 +0,0 @@ -{ - Proof of concept one handle per widget GUI. - Graeme Geldenhuys -} - -unit gui2Base; - -{$mode objfpc}{$H+} - -{$Define DEBUG} - -interface - -uses - Classes - ,fpgfx - ,GFXBase - ; - - -type - - TWidgetStyle = set of ( - wsCaptureMouse, - wsClickable, - wsOpaque - ); - - - TWidgetState = set of ( - wsEnabled, - wsIsVisible, - wsSizeIsForced, - wsHasFocus, - wsMouseInside, - wsClicked - ); - - // The following flags are used for styles - - TFButtonFlags = set of ( - btnIsEmbedded, - btnIsDefault, - btnIsPressed, - btnIsSelected, - btnHasFocus - ); - - - { TFWidget } - - TFWidget = class(TFWindow) - private - FColor: TGfxColor; - FOnClick: TNotifyEvent; - procedure EvOnMouseReleased(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); virtual; - procedure EvOnMousePressed(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); virtual; - procedure EvOnMouseLeave(Sender: TObject); virtual; - procedure SetColor(const AValue: TGfxColor); - protected - FWidgetStyle: TWidgetStyle; - FWidgetState: TWidgetState; - procedure Paint; virtual; - property OnClick: TNotifyEvent read FOnClick write FOnClick; - property Color: TGfxColor read FColor write SetColor; - public - constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); override; - constructor Create(AParent: TFCustomWindow); overload; - destructor Destroy; override; - procedure ProcessEvent(AEvent: TFEvent); override; - procedure SetFocus; - end; - - { TFForm } - - TFForm = class(TFWidget) - public - constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); override; - constructor Create; virtual; reintroduce; - property Color; - end; - - { TFPopupWindow } - {$Note TFPopupWindow is still work in progess. } - TFPopupWindow = class(TFForm) - public - constructor Create; override; - end; - - { TFButton } - - TFButton = class(TFWidget) - private - FCaption: string; - procedure SetCaption(const AValue: string); - protected - procedure Paint; override; - public - constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload; reintroduce; - property Caption: string read FCaption write SetCaption; - published - property OnClick; - end; - - { TFLabel } - - TFLabel = class(TFWidget) - private - FCaption: string; - procedure SetCaption(const AValue: string); - protected - procedure Paint; override; - public - constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload; reintroduce; - property Caption: string read FCaption write SetCaption; - end; - - { TFCustomEdit } - - TFCustomEdit = class(TFWidget) - private - FText: string; - procedure SetText(const AValue: string); - protected - procedure Paint; override; - public - constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload; reintroduce; - property Text: string read FText write SetText; - end; - - { TEdit } - - TFEdit = class(TFCustomEdit) - public - property Text; - end; - - -implementation - -const - clDkWhite: TGfxColor = (Red: $e000; Green: $e000; Blue: $e000; Alpha: 0); - cl3DShadow: TGfxColor = (Red: $8000; Green: $8000; Blue: $8000; Alpha: 0); - cl3DDkShadow: TGfxColor = (Red: $0000; Green: $0000; Blue: $0000; Alpha: 0); - cl3DHighlight: TGfxColor = (Red: $FF00; Green: $FF00; Blue: $FF00; Alpha: 0); - cl3DFace: TGfxColor = (Red: $c000; Green: $c000; Blue: $c000; Alpha: 0); - clWindow: TGfxColor = (Red: $FF00; Green: $FF00; Blue: $FF00; Alpha: 0); - cl3DLight: TGfxColor = (Red: $e000; Green: $e000; Blue: $e000; Alpha: 0); - - -// Helper functions, that will actually be in a style class. - -procedure Draw3DFrame(Canvas: TFCanvas; const ARect: TRect; Color1, Color2, Color3, Color4: TGfxColor); -begin - with ARect do - begin - Canvas.SetColor(Color1); - Canvas.DrawLine(Point(Left, Bottom - 2), TopLeft); - Canvas.DrawLine(TopLeft, Point(Right - 1, Top)); - - Canvas.SetColor(Color2); - Canvas.DrawLine(Point(Left + 1, Bottom - 3), Point(Left + 1, Top + 1)); - Canvas.DrawLine(Point(Left + 1, Top + 1), Point(Right - 2, Top + 1)); - - Canvas.SetColor(Color3); - Canvas.DrawLine(Point(Left, Bottom - 1), Point(Right - 1, Bottom - 1)); - Canvas.DrawLine(Point(Right - 1, Bottom - 1), Point(Right - 1, Top - 1)); - - Canvas.SetColor(Color4); - Canvas.DrawLine(Point(Left + 1, Bottom - 2), Point(Right - 2, Bottom - 2)); - Canvas.DrawLine(Point(Right - 2, Bottom - 2), Point(Right - 2, Top)); - end; -end; - -procedure DrawEditBox(Canvas: TFCanvas; const ARect: TRect); -begin - Draw3DFrame(Canvas, ARect, cl3DShadow, cl3DDkShadow, cl3DHighlight, cl3DFace); - Canvas.SetColor(clWindow); - with ARect do - Canvas.FillRect(Rect(Left + 2, Top + 2, Right - 2, Bottom - 2)); -end; - -{ TFWidget } - -procedure TFWidget.EvOnMouseReleased(Sender: TObject; AButton: TMouseButton; - AShift: TShiftState; const AMousePos: TPoint); -begin - {$IFDEF DEBUG} Writeln(ClassName + '.EvOnMouseReleased'); {$ENDIF} - if (wsClickable in FWidgetStyle) and (wsEnabled in FWidgetState) and - (AButton = mbLeft) then - begin - if wsClicked in FWidgetState then - begin - Exclude(FWidgetState, wsClicked); - Paint; - if Assigned(OnClick) then - OnClick(self); - end; - end; -end; - -procedure TFWidget.EvOnMousePressed(Sender: TObject; AButton: TMouseButton; - AShift: TShiftState; const AMousePos: TPoint); -begin - {$IFDEF DEBUG} Writeln(ClassName + '.EvOnMousePressed'); {$ENDIF} - if (wsClickable in FWidgetStyle) and (wsEnabled in FWidgetState) and - (AButton = mbLeft) then - begin - Include(FWidgetState, wsClicked); - SetFocus; -// Paint; - end; -end; - -procedure TFWidget.EvOnMouseLeave(Sender: TObject); -begin - Exclude(FWidgetState, wsHasFocus); -// Paint; -end; - -procedure TFWidget.SetColor(const AValue: TGfxColor); -begin - if FColor = AValue then exit; - FColor := AValue; - Paint; -end; - -procedure TFWidget.Paint; -var - r: TRect; -begin - {$IFDEF DEBUG} Writeln(ClassName + '.Paint'); {$ENDIF} - Canvas.SetColor(FColor); - r.Left := 0; - r.Top := 0; - r.Right := Width; - r.Bottom := Height; - Canvas.FillRect(r); -end; - -constructor TFWidget.Create(AParent: TFCustomWindow; - AWindowOptions: TFWindowOptions); -begin - inherited Create(AParent, AWindowOptions); - - FWidgetState := [wsEnabled]; - FColor := colLtGray; - Title := ClassName; - - // Assign some event handlers - OnMouseReleased := @EvOnMouseReleased; - OnMousePressed := @EvOnMousePressed; - OnMouseLeave := @EvOnMouseLeave; -end; - -constructor TFWidget.Create(AParent: TFCustomWindow); -begin - Create(AParent, [woChildWindow]); -end; - -destructor TFWidget.Destroy; -begin - OnMouseReleased := nil; - OnMousePressed := nil; - inherited Destroy; -end; - -procedure TFWidget.ProcessEvent(AEvent: TFEvent); -begin - inherited ProcessEvent(AEvent); - case AEvent.EventType of - etPaint: - begin - Paint; - end; - end; { case } - -end; - -procedure TFWidget.SetFocus; -begin - Include(FWidgetState, wsHasFocus); - Paint; -// FindForm.FocusedWidget := Self; -end; - -{ TFForm } - -constructor TFForm.Create(AParent: TFCustomWindow; - AWindowOptions: TFWindowOptions); -begin - inherited Create(AParent, AWindowOptions); -end; - -constructor TFForm.Create; -begin - inherited Create(nil, [woWindow]); -end; - -{ TFButton } - -procedure TFButton.SetCaption(const AValue: string); -begin - if FCaption=AValue then exit; - FCaption:=AValue; - Paint; -end; - -procedure TFButton.Paint; -var - Pt: TPoint; - lFlags: TFButtonFlags; - r: TRect; -begin - inherited Paint; - {$IFDEF DEBUG} Writeln(' - Painting ' + Caption); {$ENDIF} - lFlags := []; - r := Rect(0, 0, Width, Height); - - if (wsClicked in FWidgetState) then - Include(lFlags, btnIsPressed); - if (wsHasFocus in FWidgetState) {and not Embedded} then - begin - Include(lFlags, btnIsSelected); - end; - - { draw actual button } - if btnIsPressed in lFlags then - begin - Canvas.SetColor(cl3DShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end - else - begin - Draw3DFrame(TFCanvas(Canvas), r, cl3DHighlight, cl3DLight, cl3DDkShadow, cl3DShadow); - end; - - { draw focus rectangle } - if (btnIsSelected in lFlags) and not (btnIsPressed in lFlags) then - begin - Inc(r.Left, 2); - Inc(r.Top, 2); - Dec(r.Right, 2); - Dec(r.Bottom, 2); - Canvas.SetColor(cl3DDkShadow); - Canvas.SetLineStyle(lsDot); - Canvas.DrawRect(r); - Canvas.SetLineStyle(lsSolid); - end; - - Canvas.SetColor(colBlack); - Pt.x := (Width - Canvas.TextWidth(FCaption)) div 2; - Pt.y := ((Height - Canvas.FontCellHeight) div 2) + 1; - if (wsClicked in FWidgetState) {and (wsMouseInside in FWidgetState)} then - Pt := Pt + Point(1, 1); - Canvas.TextOut(Pt, FCaption); -end; - -constructor TFButton.Create(AParent: TFCustomWindow; APosition: TPoint); -begin - inherited Create(AParent); - Include(FWidgetStyle, wsClickable); - SetPosition(APosition); - SetClientSize(Size(75, 25)); -end; - -{ TFLabel } - -procedure TFLabel.SetCaption(const AValue: string); -var - w, h: integer; -begin - if FCaption=AValue then exit; - FCaption := AValue; - - w := Canvas.TextWidth(FCaption) + 6; - h := Canvas.FontCellHeight + 4; - SetClientSize(Size(w, h)); - Paint; -end; - -procedure TFLabel.Paint; -begin -// Color := FParent.Canvas.GetColor; - inherited Paint; - Canvas.SetColor(colWhite); - Canvas.FillRect(Rect(0,0,Width,Height)); - Canvas.SetColor(colBlack); - Canvas.TextOut(Point(0, 0), FCaption); -end; - -constructor TFLabel.Create(AParent: TFCustomWindow; APosition: TPoint); -begin - inherited Create(AParent); - SetPosition(APosition); - SetClientSize(Size(75, 22)); -end; - -{ TFPopupWindow } - -constructor TFPopupWindow.Create; -begin -// inherited Create(nil, [woPopup]); - inherited Create(nil, [woWindow]); -end; - -{ TFCustomEdit } - -procedure TFCustomEdit.SetText(const AValue: string); -var - w: integer; -begin - if FText=AValue then exit; - FText:=AValue; - w := Canvas.TextWidth(FText) + 6; - SetClientSize(Size(w, Height)); - Paint; -end; - -procedure TFCustomEdit.Paint; -begin - inherited Paint; - DrawEditBox(TFCanvas(Canvas), Rect(0, 0, Width, Height)); - Canvas.SetColor(colBlack); - if FText <> '' then - Canvas.TextOut(Point(2, 2), FText); -end; - -constructor TFCustomEdit.Create(AParent: TFCustomWindow; APosition: TPoint); -begin - inherited Create(AParent); -// OnMouseEntered := @EvMouseEntered - SetPosition(APosition); - SetClientSize(Size(100, 25)); -end; - -end. - diff --git a/prototypes/multihandle/test.lpi b/prototypes/multihandle/test.lpi deleted file mode 100644 index cb9bb62e..00000000 --- a/prototypes/multihandle/test.lpi +++ /dev/null @@ -1,54 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <PathDelim Value="\"/> - <Version Value="5"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <IconPath Value=".\"/> - <TargetFileExt Value=""/> - </General> - <VersionInfo> - <ProjectVersion Value=""/> - </VersionInfo> - <PublishOptions> - <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> - </local> - </RunParams> - <RequiredPackages Count="1"> - <Item1> - <PackageName Value="fpgfxpackage"/> - </Item1> - </RequiredPackages> - <Units Count="1"> - <Unit0> - <Filename Value="test.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="test"/> - </Unit0> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="5"/> - <PathDelim Value="\"/> - <CodeGeneration> - <Generate Value="Faster"/> - </CodeGeneration> - <Other> - <CustomOptions Value="-FUunits -"/> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/prototypes/multihandle/test.lpr b/prototypes/multihandle/test.lpr deleted file mode 100644 index 23e4f4f5..00000000 --- a/prototypes/multihandle/test.lpr +++ /dev/null @@ -1,129 +0,0 @@ -{ - Proof of concept test app for multi-handle GUI widgets. - Graeme Geldenhuys -} - -program test; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes - ,gui2Base - ,gfxbase - ,fpgfx - ; - - -type - - { TMainWindow } - - TMainWindow = class(TFForm) - procedure btnCancelClick(Sender: TObject); - procedure btnCloseClick(Sender: TObject); - procedure btnPopupClick(Sender: TObject); - private - btnClose: TFButton; - btnCancel: TFButton; - btnPopup: TFButton; - lblWelcome: TFLabel; - edEdit: TFEdit; - public - constructor Create; override; - destructor Destroy; override; - end; - - - TMyPopup = class(TFPopupWindow) - public - constructor Create; override; - end; - -const - clBlue: TGfxColor = (Red: $0000; Green: $0000; Blue: $FF00; Alpha: 0); - clLightSteelBlue: TGfxColor = (Red: $B000; Green: $C400; Blue: $DE00; Alpha: 0); - -{ TMyPopup } - -constructor TMyPopup.Create; -begin - inherited Create; - Title := 'My Popup'; - SetClientSize(Size(180, 320)); -end; - -{ TMainWindow } - -procedure TMainWindow.btnCancelClick(Sender: TObject); -begin - Writeln('You click Cancel'); -end; - -procedure TMainWindow.btnCloseClick(Sender: TObject); -begin - Writeln('You click Close'); - GFApplication.Quit; -end; - -procedure TMainWindow.btnPopupClick(Sender: TObject); -var - frm: TMyPopup; -begin - frm := TMyPopup.Create; - - GFApplication.AddWindow(frm); -// frm.SetPosition(Point(0, btnPopup.Height)); - frm.Show; -end; - -constructor TMainWindow.Create; -begin - inherited Create; - Title := 'fpGUI multi-handle example'; - SetClientSize(Size(320, 200)); - Color := clLightSteelBlue; - - btnClose := TFButton.Create(self, Point(20, 150)); - btnClose.Caption := 'Close'; - btnClose.OnClick := @btnCloseClick; - - btnCancel := TFButton.Create(self, Point(150, 150)); - btnCancel.Caption := 'Cancel'; - btnCancel.OnClick := @btnCancelClick; - - btnPopup := TFButton.Create(self, Point(80, 80)); - btnPopup.Caption := 'Popup'; - btnPopup.OnClick := @btnPopupClick; - - lblWelcome := TFLabel.Create(self, Point(10, 10)); - lblWelcome.Caption := 'So what do you think?'; - - edEdit := TFEdit.Create(self, Point(65, 110)); - edEdit.Text := 'Multi-Handle widgets'; -end; - -destructor TMainWindow.Destroy; -begin - btnClose.Free; - btnCancel.Free; - btnPopup.Free; - lblWelcome.Free; - inherited Destroy; -end; - - -var - MainWindow: TMainWindow; -begin - GFApplication.Initialize; - MainWindow := TMainWindow.Create; - GFApplication.AddWindow(MainWindow); - MainWindow.Show; - GFApplication.Run; - MainWindow.Free; -end. - diff --git a/prototypes/newmultihandle/examples/helloworld.lpi b/prototypes/newmultihandle/examples/helloworld.lpi deleted file mode 100644 index 779ed512..00000000 --- a/prototypes/newmultihandle/examples/helloworld.lpi +++ /dev/null @@ -1,52 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <PathDelim Value="\"/> - <Version Value="5"/> - <General> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <IconPath Value=".\"/> - <TargetFileExt Value=".exe"/> - </General> - <VersionInfo> - <ProjectVersion Value=""/> - </VersionInfo> - <PublishOptions> - <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> - </local> - </RunParams> - <RequiredPackages Count="2"> - <Item1> - <PackageName Value="fpguipackage"/> - </Item1> - <Item2> - <PackageName Value="fpGFXPackage"/> - </Item2> - </RequiredPackages> - <Units Count="1"> - <Unit0> - <Filename Value="helloworld.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="helloworld"/> - </Unit0> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="5"/> - <PathDelim Value="\"/> - <CodeGeneration> - <Generate Value="Faster"/> - </CodeGeneration> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/prototypes/newmultihandle/examples/helloworld.lpr b/prototypes/newmultihandle/examples/helloworld.lpr deleted file mode 100644 index ab364d59..00000000 --- a/prototypes/newmultihandle/examples/helloworld.lpr +++ /dev/null @@ -1,108 +0,0 @@ -program HelloWorld; - -{$mode objfpc}{$h+} - -uses - Classes, - fpgui, - fpGFX, - gfxBase; - -type - TMainForm = class(TFWidget) - private - btnHello: TFButton; - txtEdit: TFEdit; - procedure FormPaint(Sender: TObject); - public - constructor Create(AParent: TFCustomWindow); override; - procedure AfterConstruction; override; - end; - - -{ TMainForm } - -procedure TMainForm.FormPaint(Sender: TObject); -begin - Canvas.SetColor(colBlack); - Canvas.DrawLine(0, 0, 100, 100); - Canvas.DrawLine(5, 0, 95, 100); - Canvas.DrawLine(10, 0, 90, 100); - - Canvas.TextOut(Point(5, 150), 'This should be at (5, 150).'); - - Canvas.SetColor(colBlue); - Canvas.FillRect(Rect(5, 100, 55, 150)); - Canvas.SetColor(colGreen); - Canvas.FillRect(Rect(60, 100, 110, 150)); - Canvas.SetColor(colRed); - Canvas.FillRect(Rect(115, 100, 165, 150)); - - Canvas.SetColor(colRed); - Canvas.DrawRect(Rect(100, 5, 150, 55)); - Canvas.SetColor(colGreen); - Canvas.DrawRect(Rect(105, 10, 155, 60)); - Canvas.SetColor(colBlue); - Canvas.DrawRect(Rect(110, 15, 160, 65)); - - Canvas.SetColor(colRed); - Canvas.DrawCircle(Rect(10, 175, 50, 215)); - Canvas.SetColor(colGreen); - Canvas.DrawCircle(Rect(65, 175, 105, 215)); - Canvas.SetColor(colBlue); - Canvas.DrawCircle(Rect(120, 175, 160, 215)); -end; - -constructor TMainForm.Create(AParent: TFCustomWindow); -begin - inherited; - self.OnPaint := @FormPaint; -end; - -procedure TMainForm.AfterConstruction; -var - lSize: TSize; - lPoint: TPoint; -begin - inherited AfterConstruction; - -// BorderWidth := 8; -// Text := 'fpGUI Application'; - - { create our button } - btnHello := TFButton.Create('Hello World!', self); - lSize.cx := 100; - lSize.cy := 25; - btnHello.SetClientSize(lSize); - lPoint.x := 25; - lPoint.y := 25; - btnHello.SetPosition(lPoint); - btnHello.Show; - - { create the edit } - txtEdit := TFEdit.Create(self); - lSize.cx := 100; - lSize.cy := 25; - txtEdit.SetClientSize(lSize); - lPoint.x := 25; - lPoint.y := 100; - txtEdit.SetPosition(lPoint); - txtEdit.Show; - - { set a min and max size } - lSize.cx := 200; - lSize.cy := 300; - SetClientSize(lSize); - SetMinMaxClientSize(lSize, lSize); -end; - - -var - MainForm: TMainForm; -begin - GFApplication.Initialize; - MainForm := TMainForm.Create(nil); - MainForm.Show; - GFApplication.Run; -end. - diff --git a/prototypes/newmultihandle/fpgui.pas b/prototypes/newmultihandle/fpgui.pas deleted file mode 100644 index 9649e21e..00000000 --- a/prototypes/newmultihandle/fpgui.pas +++ /dev/null @@ -1,43 +0,0 @@ -unit fpgui; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, gfxbase, fpgfx; - -{ Style includes } -{$include gui_style.inc} - -{ TFWidget includes } -{$include gui_widget.inc} - -{ Primary widgets includes } -{$include gui_button.inc} -{$include gui_edit.inc} - -var - { Default Styles } - GFDefaultStyle: TFStyle; - -implementation - -{$define READ_IMPLEMENTATION} - -{ Style includes } -{$include gui_style.inc} - -{ TFWidget includes } -{$include gui_widget.inc} - -{ Primary widgets includes } -{$include gui_button.inc} -{$include gui_edit.inc} - -initialization - { Default Styles } - GFDefaultStyle := TFStyle.Create; - -end. - diff --git a/prototypes/newmultihandle/fpguipackage.lpk b/prototypes/newmultihandle/fpguipackage.lpk deleted file mode 100644 index 19788333..00000000 --- a/prototypes/newmultihandle/fpguipackage.lpk +++ /dev/null @@ -1,60 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <Package Version="2"> - <PathDelim Value="\"/> - <Name Value="fpguipackage"/> - <CompilerOptions> - <Version Value="5"/> - <PathDelim Value="\"/> - <SearchPaths> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <CodeGeneration> - <Generate Value="Faster"/> - </CodeGeneration> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> - <Files Count="5"> - <Item1> - <Filename Value="fpgui.pas"/> - <UnitName Value="fpgui"/> - </Item1> - <Item2> - <Filename Value="gui_button.inc"/> - <Type Value="Include"/> - </Item2> - <Item3> - <Filename Value="gui_widget.inc"/> - <Type Value="Include"/> - </Item3> - <Item4> - <Filename Value="gui_style.inc"/> - <Type Value="Include"/> - </Item4> - <Item5> - <Filename Value="gui_edit.inc"/> - <Type Value="Include"/> - </Item5> - </Files> - <Type Value="RunAndDesignTime"/> - <RequiredPkgs Count="2"> - <Item1> - <PackageName Value="fpGFXPackage"/> - </Item1> - <Item2> - <PackageName Value="FCL"/> - <MinVersion Major="1" Valid="True"/> - </Item2> - </RequiredPkgs> - <UsageOptions> - <UnitPath Value="$(PkgOutDir)"/> - </UsageOptions> - <PublishOptions> - <Version Value="2"/> - <DestinationDirectory Value="$(TestDir)\publishedpackage\"/> - <IgnoreBinaries Value="False"/> - </PublishOptions> - </Package> -</CONFIG> diff --git a/prototypes/newmultihandle/fpguipackage.pas b/prototypes/newmultihandle/fpguipackage.pas deleted file mode 100644 index b53553c8..00000000 --- a/prototypes/newmultihandle/fpguipackage.pas +++ /dev/null @@ -1,20 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! -This source is only used to compile and install the package. - } - -unit fpguipackage; - -interface - -uses - fpgui, LazarusPackageIntf; - -implementation - -procedure Register; -begin -end; - -initialization - RegisterPackage('fpguipackage', @Register); -end. diff --git a/prototypes/newmultihandle/gui_button.inc b/prototypes/newmultihandle/gui_button.inc deleted file mode 100644 index ab73558f..00000000 --- a/prototypes/newmultihandle/gui_button.inc +++ /dev/null @@ -1,139 +0,0 @@ -{%mainunit fpgui.pas} - -{$ifndef READ_IMPLEMENTATION} - -type - - { TFButton } - - TFButton = class(TFWidget) - private - FIsPressed: Boolean; - FText: string; - procedure SetText(const AValue: string); - protected - procedure EvFocusIn; override; - procedure EvFocusOut; override; - procedure EvKeyPressed(AKey: Word); override; - procedure EvKeyReleased(AKey: Word); override; - procedure EvMouseEnter(const AMousePos: TPoint); override; - procedure EvMouseLeave; override; - procedure EvMousePressed(AButton: TMouseButton; const AMousePos: TPoint); override; - procedure EvMouseReleased(AButton: TMouseButton; const AMousePos: TPoint); override; - procedure EvPaint; override; - public - { Constructors and Destructors } - constructor Create(AParent: TFCustomWindow); override; - constructor Create(ACaption: string; AParent: TFCustomWindow); - { Properties } - property Text: string read FText write SetText; - end; - - -{$else} - -constructor TFButton.Create(AParent: TFCustomWindow); -begin - inherited Create(AParent); - - FDrawBackground := False; - Focusable := True; - - SetClientSize(Size(100, 50)); -end; - -constructor TFButton.Create(ACaption: string; AParent: TFCustomWindow); -begin - Create(AParent); - - Text := ACaption; -end; - -procedure TFButton.SetText(const AValue: string); -begin - FText := AValue; - - Invalidate; -end; - -procedure TFButton.EvFocusIn; -begin - inherited EvFocusIn; -end; - -procedure TFButton.EvFocusOut; -begin - inherited EvFocusOut; -end; - -procedure TFButton.EvKeyPressed(AKey: Word); -begin - inherited EvKeyPressed(AKey); -end; - -procedure TFButton.EvKeyReleased(AKey: Word); -begin - inherited EvKeyReleased(AKey); -end; - -procedure TFButton.EvMouseEnter(const AMousePos: TPoint); -begin - inherited EvMouseEnter(AMousePos); -end; - -procedure TFButton.EvMouseLeave; -begin - FIsPressed := False; - - Invalidate; - - inherited EvMouseLeave; -end; - -procedure TFButton.EvMousePressed(AButton: TMouseButton; const AMousePos: TPoint - ); -begin - WriteLn('Mouse Pressed'); - - FIsPressed := True; - - Invalidate; - - inherited EvMousePressed(AButton, AMousePos); -end; - -procedure TFButton.EvMouseReleased(AButton: TMouseButton; - const AMousePos: TPoint); -begin - WriteLn('Mouse Released'); - - FIsPressed := False; - - Invalidate; - - inherited EvMouseReleased(AButton, AMousePos); -end; - -procedure TFButton.EvPaint; -var - Flags: TFButtonFlags; -begin - { Prepare the flags } - - Flags := []; - - if FIsPressed then - Include(Flags, fbfIsPressed); - -{ if FFocused then - Include(lBtnFlags, btnHasFocus); } - - { Draw the button } - - GFDefaultStyle.DrawButtonFace(Canvas, Bounds(0, 0, Width, Height), Flags); - - inherited EvPaint(); -end; - -{$endif} - diff --git a/prototypes/newmultihandle/gui_edit.inc b/prototypes/newmultihandle/gui_edit.inc deleted file mode 100644 index e0cc84aa..00000000 --- a/prototypes/newmultihandle/gui_edit.inc +++ /dev/null @@ -1,109 +0,0 @@ -{%mainunit fpgui.pas}
-
-{$ifndef READ_IMPLEMENTATION}
-
-type
-
- { TFEdit }
-
- TFEdit = class(TFWidget)
- private
- FText: String;
- procedure SetText(const AValue: String);
- protected
- procedure EvFocusIn; override;
- procedure EvFocusOut; override;
- procedure EvKeyPressed(AKey: Word); override;
- procedure EvKeyReleased(AKey: Word); override;
- procedure EvKeyChar(AKeyChar: Char); override;
- procedure EvMousePressed(AButton: TMouseButton; const AMousePos: TPoint); override;
- procedure EvMouseReleased(AButton: TMouseButton; const AMousePos: TPoint); override;
- procedure EvPaint; override;
- public
- { Constructors and Destructors }
- constructor Create(AParent: TFCustomWindow); override;
- { Properties }
- property Text: String read FText write SetText;
- end;
-
-
-{$else}
-
-constructor TFEdit.Create(AParent: TFCustomWindow);
-begin
- inherited Create(AParent);
-
- FDrawBackground := False;
- Focusable := True;
-
- SetClientSize(Size(100, 50));
-end;
-
-procedure TFEdit.SetText(const AValue: String);
-begin
- if FText = AValue then exit;
-
- FText := AValue;
-
- Invalidate;
-end;
-
-procedure TFEdit.EvFocusIn;
-begin
- inherited EvFocusIn;
-end;
-
-procedure TFEdit.EvFocusOut;
-begin
- inherited EvFocusOut;
-end;
-
-procedure TFEdit.EvKeyPressed(AKey: Word);
-begin
- WriteLn('KeyPressed');
-
- inherited EvKeyPressed(AKey);
-end;
-
-procedure TFEdit.EvKeyReleased(AKey: Word);
-begin
- WriteLn('KeyReleased');
-
- inherited EvKeyReleased(AKey);
-end;
-
-procedure TFEdit.EvKeyChar(AKeyChar: Char);
-begin
- WriteLn('KeyChar');
-
- FText := FText + AKeyChar;
-
- Invalidate;
-end;
-
-procedure TFEdit.EvMousePressed(AButton: TMouseButton; const AMousePos: TPoint);
-begin
- WriteLn('Mouse Pressed');
-
- inherited EvMousePressed(AButton, AMousePos);
-end;
-
-procedure TFEdit.EvMouseReleased(AButton: TMouseButton;
- const AMousePos: TPoint);
-begin
- WriteLn('Mouse Released');
-
- inherited EvMouseReleased(AButton, AMousePos);
-end;
-
-procedure TFEdit.EvPaint;
-begin
- { Draw the edit }
-
- GFDefaultStyle.DrawEdit(Canvas, Bounds(0, 0, Width, Height), FText);
-
- inherited EvPaint();
-end;
-
-{$endif}
-
diff --git a/prototypes/newmultihandle/gui_style.inc b/prototypes/newmultihandle/gui_style.inc deleted file mode 100644 index 0c11bf0b..00000000 --- a/prototypes/newmultihandle/gui_style.inc +++ /dev/null @@ -1,107 +0,0 @@ -{%mainunit fpgui.pas}
-
-{$ifndef READ_IMPLEMENTATION}
-
-type
-
- TFButtonFlag = (fbfIsPressed);
- TFButtonFlags = set of TFButtonFlag;
-
- { TFStyle }
-
- TFStyle = class(TObject)
- public
- constructor Create; virtual;
- procedure DrawButtonFace(ACanvas: TFCustomCanvas; ARect: TRect; AFlags: TFButtonFlags); virtual;
- procedure DrawControlFrame(ACanvas: TFCustomCanvas; ARect: TRect); virtual;
- procedure DrawDirectionArrow(ACanvas: TFCustomCanvas; ARect: TRect; direction: Integer); virtual;
- procedure DrawEdit(ACanvas: TFCustomCanvas; ARect: TRect; AText: string); virtual;
- end;
-
-const
- colShadow1: TGfxColor = (Red: $80; Green: $80; Blue: $80; Alpha: $00);
- colShadow2: TGfxColor = (Red: $40; Green: $40; Blue: $40; Alpha: $00);
- colHilite1: TGfxColor = (Red: $E0; Green: $E0; Blue: $E0; Alpha: $00);
- colHilite2: TGfxColor = (Red: $FF; Green: $FF; Blue: $FF; Alpha: $00);
- colGrayBlue: TGfxColor = (Red: $7F; Green: $9D; Blue: $B9; Alpha: $00);
-
-{$else}
-
-constructor TFStyle.Create;
-begin
- inherited Create;
-
-end;
-
-procedure TFStyle.DrawButtonFace(ACanvas: TFCustomCanvas; ARect: TRect; AFlags: TFButtonFlags);
-var
- x, y, w, h: Integer;
-begin
- x := ARect.Left;
- y := ARect.Top;
- w := ARect.Right - ARect.Left;
- h := ARect.Bottom - ARect.Top;
-
- { Background }
- ACanvas.SetColor(colLtGray);
- ACanvas.FillRect(ARect);
-
- // Left and Top (outer)
- if (fbfIsPressed in AFlags) then ACanvas.SetColor(colShadow2)
- else ACanvas.SetColor(colHilite1);
-
- ACanvas.DrawLine(x, y + h - 2, x, y); // left
- ACanvas.DrawLine(x, y, x + w - 1, y); // top
-
- // Left and Top (inner)
- if (fbfIsPressed in AFlags) then
- begin
- ACanvas.SetColor(colShadow1);
- ACanvas.DrawLine(x + 1, y + h - 3, x + 1, y + 1); // left
- ACanvas.DrawLine(x + 1, y + 1, x + w - 2, y + 1); // top
- end;
-
- // Right and Bottom (outer)
- if (fbfIsPressed in AFlags) then
- ACanvas.SetColor(colShadow2)
- else
- ACanvas.SetColor(colShadow2);
-
- ACanvas.DrawLine(x + w - 1, y + 1, x + w - 1, y + h - 1); // right
- ACanvas.DrawLine(x, y + h - 1, x + w - 1, y + h - 1); // bottom
-
- // Right and Bottom (inner)
- if fbfIsPressed in AFlags then
- ACanvas.SetColor(colHilite1)
- else
- ACanvas.SetColor(colShadow1);
-
- ACanvas.DrawLine(x + w - 2, y + 2, x + w - 2, y + h - 2); // right
- ACanvas.DrawLine(x + 1, y + h - 2, x + w - 2, y + h - 2); // bottom
-end;
-
-procedure TFStyle.DrawControlFrame(ACanvas: TFCustomCanvas; ARect: TRect);
-begin
-end;
-
-procedure TFStyle.DrawDirectionArrow(ACanvas: TFCustomCanvas; ARect: TRect; direction: Integer);
-begin
-end;
-
-procedure TFStyle.DrawEdit(ACanvas: TFCustomCanvas; ARect: TRect; AText: string);
-begin
- { Inner area }
- ACanvas.SetColor(colWhite);
- ACanvas.FillRect(ARect);
-
- { The text }
-
- ACanvas.TextOut(Point(5, 0), AText);
-
- { Outer border }
- ACanvas.SetColor(colGrayBlue);
- ACanvas.DrawRect(ARect);
-end;
-
-{$endif}
-
diff --git a/prototypes/newmultihandle/gui_widget.inc b/prototypes/newmultihandle/gui_widget.inc deleted file mode 100644 index 7f99d9d1..00000000 --- a/prototypes/newmultihandle/gui_widget.inc +++ /dev/null @@ -1,41 +0,0 @@ -{%mainunit fpgui.pas} - -{$ifndef READ_IMPLEMENTATION} - -type - TFWidget = class(TFWindow) - protected - FDrawBackground: Boolean; - - procedure EvPaint; override; - public - constructor Create(AParent: TFCustomWindow); virtual; - end; - -{$else} - -constructor TFWidget.Create(AParent: TFCustomWindow); -begin - if (AParent = nil) then inherited Create(nil, [woWindow]) - else inherited Create(AParent, [woChildWindow]); - - { Inherited components should set this to False, - or the background will override their painting } - FDrawBackground := True; - - SetClientSize(Size(125, 125)); -end; - -procedure TFWidget.EvPaint; -begin - if FDrawBackground then - begin - Canvas.SetColor(colLtGray); - Canvas.FillRect(Bounds(0, 0, Width, Height)); - end; - - inherited EvPaint(); -end; - -{$endif} - |