diff --git a/lcl/interfaces/carbon/carbonwinapi.inc b/lcl/interfaces/carbon/carbonwinapi.inc index 7982a6039d..14cf75cca2 100644 --- a/lcl/interfaces/carbon/carbonwinapi.inc +++ b/lcl/interfaces/carbon/carbonwinapi.inc @@ -430,13 +430,6 @@ begin Result := HPEN(TCarbonPen.Create(LogPen)); end; -function TCarbonWidgetSet.CreatePixmapIndirect(const Data: Pointer; - const TransColor: Longint): HBITMAP; -begin - DebugLn('TCarbonWidgetSet.CreatePixmapIndirect TODO'); - Result := 0; -end; - {------------------------------------------------------------------------------ Method: CreatePolygonRgn Params: Points - Pointer to array of polygon points diff --git a/lcl/interfaces/carbon/carbonwinapih.inc b/lcl/interfaces/carbon/carbonwinapih.inc index 402ad96781..a34a176f38 100644 --- a/lcl/interfaces/carbon/carbonwinapih.inc +++ b/lcl/interfaces/carbon/carbonwinapih.inc @@ -61,7 +61,6 @@ function CreateFontIndirect(const LogFont: TLogFont): HFONT; override; function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override; function CreatePalette(const LogPalette: TLogPalette): HPALETTE; override; function CreatePenIndirect(const LogPen: TLogPen): HPEN; override; -function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; override; function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; Override; function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; override; diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 84b2984310..dd769d6083 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -1991,74 +1991,6 @@ begin Result := HPEN(PtrUInt(GObject)); end; -{------------------------------------------------------------------------------ - Function: CreatePixmapIndirect - Params: Data: Raw pixmap data (PPGChar of xpm file, - You can use graphics.XPMToPPChar to create this) - Returns: Handle to LCL bitmap - - Creates a bitmap from raw pixmap data. - If TransColor < 0 the transparency mask will be automatically gnerated. - ------------------------------------------------------------------------------} -function TGtkWidgetSet.CreatePixmapIndirect(const Data: Pointer; - const TransColor: Longint): HBITMAP; -var - GdiObject: PGdiObject absolute Result; - GDKColor: TGDKColor; - ColorMap: PGdkColormap; - P: Pointer; - Depth : Longint; -begin - GdiObject := NewGDIObject(gdiBitmap); - if TransColor >= 0 - then begin - GDKColor := AllocGDKColor(TransColor); - p := @GDKColor; - end - else p := nil; // automatically create transparency mask - - {$IFDEF DebugGDKTraps} - BeginGDKErrorTrap; - {$ENDIF} - - ColorMap := gdk_colormap_get_system; - - try - with GdiObject^.GDIPixmapObject do - Image := gdk_pixmap_colormap_create_from_xpm_d(nil, Colormap, Mask, p, Data); - - Depth := gdk_drawable_get_depth(GdiObject^.GDIPixmapObject.Image); - - if (GdiObject^.Visual <> nil) and not GdiObject^.SystemVisual - then gdk_visual_unref(GdiObject^.Visual); - GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIPixmapObject.Image); - - if GdiObject^.Visual = nil - then begin - GdiObject^.Visual := gdk_visual_get_best_with_depth(Depth); - if GdiObject^.Visual = nil - then GdiObject^.Visual := gdk_visual_get_system; - GdiObject^.SystemVisual := True; - end - else begin - gdk_visual_ref(GdiObject^.Visual); - GdiObject^.SystemVisual := False; - end; - - if GdiObject^.Colormap <> nil - then gdk_colormap_unref(GdiObject^.Colormap); - GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, GdkFalse); - - GdiObject^.GDIBitmapType := gbPixmap; - except - DisposeGDIObject(GdiObject); - GdiObject := nil; - end; - {$IFDEF DebugGDKTraps} - EndGDKErrorTrap; - {$ENDIF} -end; - {------------------------------------------------------------------------------ Method: CreatePolygonRgn Params: Points, NumPts, FillMode diff --git a/lcl/interfaces/gtk/gtkwinapih.inc b/lcl/interfaces/gtk/gtkwinapih.inc index 1fe5fdb6bf..ffb83a94e3 100644 --- a/lcl/interfaces/gtk/gtkwinapih.inc +++ b/lcl/interfaces/gtk/gtkwinapih.inc @@ -60,7 +60,6 @@ function CreateFontIndirect(const LogFont: TLogFont): HFONT; override; function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override; function CreatePalette(const LogPalette: TLogPalette): HPALETTE; override; function CreatePenIndirect(const LogPen: TLogPen): HPEN; override; -function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; override; Function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; Override; function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; override; diff --git a/lcl/interfaces/qt/qtwinapi.inc b/lcl/interfaces/qt/qtwinapi.inc index 439ee8c2bc..cf6aca27b7 100644 --- a/lcl/interfaces/qt/qtwinapi.inc +++ b/lcl/interfaces/qt/qtwinapi.inc @@ -641,21 +641,6 @@ begin Result := HPEN(QtPen); end; - -{------------------------------------------------------------------------------ - Function: CreatePixmapIndirect - Params: const Data: Pointer; const TransColor: Longint - Returns: HBITMAP - - ------------------------------------------------------------------------------} -function TQtWidgetSet.CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; -begin - {$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION} - WriteLn('***** [WinAPI TQtWidgetSet.CreatePixmapIndirect] missing implementation '); - {$endif} - Result := 0; -end; - {------------------------------------------------------------------------------ Function: CreatePolygonRgn Params: none diff --git a/lcl/interfaces/qt/qtwinapih.inc b/lcl/interfaces/qt/qtwinapih.inc index 1d076131bc..b8cb72dc03 100644 --- a/lcl/interfaces/qt/qtwinapih.inc +++ b/lcl/interfaces/qt/qtwinapih.inc @@ -60,7 +60,6 @@ function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; override; function CreateFontIndirect(const LogFont: TLogFont): HFONT; override; function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override; function CreatePenIndirect(const LogPen: TLogPen): HBRUSH; override; -function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; override; function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override; function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override; diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index 9f825f6b2c..4e650b364f 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -830,347 +830,6 @@ Begin Result := Windows.CreatePenIndirect(Windows.LOGPEN(LP)); End; -{------------------------------------------------------------------------------ - Method: CreatePixmapIndirect - Params: Data - Raw pixmap data - TransColor - Color of transparent spots - Returns: Handle to LCL bitmap - - Creates a bitmap from raw pixmap data. - ------------------------------------------------------------------------------} -function TWin32WidgetSet.CreatePixmapIndirect(const Data: Pointer; const TransColor: LongInt): HBITMAP; -begin - {$note TODO: implement default implementation on intfimage & XPM reader} - Result := inherited CreatePixmapIndirect(Data, TransColor); -end; -(* -Type - PColorMap = ^TColorMap; - TColorMap = Record - Alias: String; - Color: DWORD; - End; - PPixmapArray = ^TPixmapArray; - TPixmapArray = Array[0..1000] Of PChar; -var - CharPtr: PChar; - AliasLen : Byte; - ColorCount : Cardinal; - Height, Width : Cardinal; - S: String; - Colors: TMap; - ColorIdx: DWord; - ColorVal: DWord; - n: Integer; - - AList : TList; - hdcScreen : HDC; - hdcBitmap : HDC; - hbmBitmap : HBITMAP ; - OldObject : HGDIOBJ; - PixmapArray : PPixmapArray; - Info : String; - PixmapInfo : TStringList; - - procedure NormalizeString(Var Str: String); - var - S: String; - begin - Assert(False, 'Trace:NormalizeString - Start'); - Str := StringReplace(Str, #9, ' ', [rfReplaceAll]); - S := ''; - While True Do Begin - Str := StringReplace(Str, ' ', ' ', True); - If Str = S Then Break; - S := Str; - End; - Assert(False, 'Trace:NormalizeString - Exit'); - End; - - function StrToInt(Const Str: String): DWORD; - Var - S: String; - Begin - Assert(False, 'Trace:StrToInt - Start'); - S := Trim(Str); - Result := SysUtils.StrToInt(S); - Assert(False, 'Trace:StrToInt - Exit'); - End; - - procedure CreateColorMap; - Var - Elem: String; - I, Idx: Integer; - ColorMap: PColorMap; - Begin - Assert(False, 'Trace:CreateColorMap - Start'); - If ColorCount = 0 Then Begin - Assert(False, 'Trace:CreateColorMap - Color count was not retrieved; can''t create color map'); - AList := Nil; - Exit; - End; - - AList := TList.Create; - For I := 1 To ColorCount Do Begin - Try - Elem := String(PixmapArray^[I]); - - While Pos(Elem[Length(Elem)],'",')>0 do Elem:=Copy(Elem,1,Length(Elem)-1); - - Idx := Cardinal(Pos(Elem, '"'))+AliasLen+4; - New(ColorMap); - ColorMap^.Alias := Copy(Elem, 1, AliasLen); - If Copy(Elem, idx, 1) = '#' Then begin - //ColorMap^.Color := StrToInt('$'+Copy(Elem,Idx,6)); - ColorMap^.Color := RGB( - Byte(StrToInt('$'+Copy(Elem,Idx+1,2))), - Byte(StrToInt('$'+Copy(Elem,Idx+3,2))), - Byte(StrToInt('$'+Copy(Elem,Idx+5,2)))); - end - Else - ColorMap^.Color := TransColor; - Assert(False, Format('Trace:CreateColorMap - color-map entry info --> item: %D, data: %S, alias: %S, color:0x%X', [I, String(PixmapArray^[I]), ColorMap^.Alias, ColorMap^.Color])); - AList.Add(ColorMap); - Except - On E: Exception Do Assert(False, Format('Trace:CreateColorMap - Could not create color-map entry --> %S', [E.Message])); - End; - End; - Assert(False, 'Trace:CreateColorMap - Exit'); - End; - - procedure DestroyColorMap; - var - ColorMap : PColorMap; - Begin - Assert(False, 'Trace:DestroyColorMap - Start'); - While AList.Count>0 do begin - ColorMap:=PColorMap(AList.Items[0]); - Dispose(ColorMap); - AList.Delete(0); - end; - If AList <> Nil Then Begin - AList.Free; - AList := Nil; - End; - Assert(False, 'Trace:DestroyColorMap - Exit'); - End; - - function GetColorFromAlias(Alias:String):DWORD; - var - i : Cardinal; - begin - result:=0; - i :=0; - if AList.Count>0 then begin - repeat - if (TColorMap(AList.Items[i]^).Alias=Alias) then begin - result:=TColorMap(AList.Items[i]^).Color; - break; - end; - Inc(i); - until (i>=ColorCount); - end; - end; - - procedure DoDrawBitmap; - Var - CX,CY : Cardinal; - Line,Alias : String; - Begin - Assert(False, 'Trace:DoDrawBitmap - Start'); - - If (ColorCount = 0) Or (AList = Nil) Then - Begin - Assert(False, 'Trace:DoDrawBitmap - No information to create bitmap'); - Exit; - End; - - for CY:=0 to Height-1 do begin - Line:=String(PixmapArray^[1+ColorCount+CY]); - While Pos(Line[Length(Line)],'",')>0 do Line:=Copy(Line,1,Length(Line)-1); - for CX:=0 to Width-1 do begin - Alias:=Copy(Line,1+CX*AliasLen,AliasLen); - Windows.SetPixel(hdcBitmap,CX,CY,GetColorFromAlias(Alias)); - end; - end; - Assert(False, 'Trace:DoDrawBitmap - Exit'); - End; - - function NextStart: Boolean; - var - InLineComment, // Pointer is in a line comment - InBlockComment: Boolean; // Pointer is in a block comment - begin - // moves CharPtr to the first char in a string - while CharPtr^ <> #0 do - begin - case CharPtr^ of - '/': begin - if not (InLineComment or InBlockComment) - then begin - Inc(CharPtr); - case CharPtr^ of - '/': InLineComment := True; - '*': InBlockComment := True; - else - Continue; - end; - end; - end; - '*': begin - if InBlockComment - then begin - Inc(CharPtr); - if CharPtr^ <> '/' then Continue; - InBlockComment := False; - end; - end; - #10, #13: begin - InLineComment := False; - end; - '"': begin - if not (InLineComment or InBlockComment) - then begin - Inc(CharPtr); - Result := True; - Exit; - end; - end; - end; - Inc(CharPtr); - end; - Result := False; - end; - - function CopyText: String; - begin - Result := ''; - while CharPtr^ <> #0 do - begin - case CharPtr^ of - '"': begin - Inc(CharPtr); - Exit; - end; - '\': begin - Inc(CharPtr); - case CharPtr^ of - 'n': Result := Result + #10; - 't': Result := Result + #9; - #0: Exit; - else - Result := Result + CharPtr^; - end; - end; - #10, #13:; //ignore - else - Result := Result + CharPtr^; - end; - Inc(CharPtr); - end; - end; - - -begin - Result := 0; - - CharPtr := Data; - if not NextStart then Exit; // no strings found - S := CopyText; - if S = '' then Exit; //no pixmap definition - - Width := StringToIntDef(GetPart('', ' ', S), 0); - Height := StringToIntDef(GetPart(' ', ' ', S), 0); - ColorCount := StringToIntDef(GetPart(' ', ' ', S), 0); - AliasLen := StringToIntDef(S, 0); - - // fill color table - Colors := TMap.Create(itu4, 4); - for n := 1 to ColorCount do - begin - if not NextStart then Exit; // no strings found - S := CopyText; - if S = '' then Exit; //no color definition - ColorIdx := 0; - Move(S[1], ColorIdx, AliasLen); - Delete(S, 1, AliasLen); - S := GetPart('c', '', S); - while (Length(S) > 0) and (S[1] in [' ', #9]) do Delete(S, 1, 1); - if S = '' then Exit; //no color - case S[1] of - '0'..'9': ColorVal := StrToIntDef(S, TransColor); - '#': ColorVal := StrToIntDef('$'+S, TransColor); - else - case StringCase(S, [none, black, white], True, False) of - 0: ColorVal := TransColor; - 1: ColorVal := $00000000; - 2: ColorVal := $00FFFFFF; - else - // todo: some text - ColorVal := TransColor; - end; - end; - Colors.Add(ColorIdx, ColorVal); - end; - - - - PixmapArray := PPixmapArray(Data); - Info := String(PixmapArray^[0]); - PixmapInfo := TStringList.Create;; - - NormalizeString(Info); - //My own Split: - while Pos(' ',Info)>0 do begin - PixmapInfo.Add(Copy(Info,1,Pos(' ',Info)-1)); //Add first String to list - Delete(Info,1,Pos(' ',Info)); //Delete String + Space - end; - if Length(Info)>0 then PixmapInfo.Add(Info); //Add last String; - - // I don't know where this Split is defines, but it does something weired - // PixmapInfo := Split(String(PixmapArray^[0]), ' ', 3, False); - If PixmapInfo.Count = 6 Then Assert(False, 'Trace:TODO: TWin32WidgetSet.CreatePixmapIndirect - Get Pixmaps with six sections working'); - - Try - Width := StrToInt(PixmapInfo[0]); Assert(False, Format('Trace: Pixmap width --> %D', [Width])); - Height := StrToInt(PixmapInfo[1]); Assert(False, Format('Trace: Pixmap height --> %D', [Height])); - ColorCount := StrToInt(PixmapInfo[2]); Assert(False, Format('Trace: number of colors --> %D', [ColorCount])); - - While Pos(PixmapInfo[3][Length(PixmapInfo[3])],'",')>0 do - PixmapInfo[3]:=Copy(PixmapInfo[3],1,Length(PixMapInfo[3])-1); - - AliasLen := StrToInt(PixmapInfo[3]); - - Assert(False, Format('Trace: characters per pixel --> %D', [AliasLen])); - Assert(False, Format('Trace:TWin32WidgetSet.CreatePixmapIndirect - Pixmap info: Width - %D; Height - %D; Number of Colors - %D; Characters per pixel - %D; Transparent color - 0x%X', [Width, Height, ColorCount, AliasLen, TransColor])); - Except - On E: Exception Do - Begin - Assert(False, 'Trace:Error: TWin32WidgetSet.CreatePixmapIndirect - could not retrieve pixmap info --> ' + E.Message); - End; - End; - - If (Width <> 0) And (Height <> 0) Then Begin - hdcScreen := Windows.GetDC(GetDesktopWindow); - hdcBitmap := CreateCompatibleDC(hdcScreen); - hbmBitmap := CreateCompatibleBitmap(hdcScreen, Width, Height); - OldObject := SelectObject(hdcBitmap, hbmBitmap); - CreateColorMap; - DoDrawBitmap; - DestroyColorMap; - ReleaseDC(GetDesktopWindow, hdcScreen); - SelectObject(hdcBitmap, OldObject); - DeleteDC(hdcBitmap); - Result:=hbmBitmap; - end; - PixmapInfo.Free; - PixmapInfo := Nil; - PixmapArray := Nil; - - Assert(False, 'Trace:TWin32WidgetSet.CreatePixmapIndirect - Exit'); -End; -*) - {------------------------------------------------------------------------------ Method: CreatePolygonRgn Params: Points, NumPts, FillMode diff --git a/lcl/interfaces/win32/win32winapih.inc b/lcl/interfaces/win32/win32winapih.inc index b472ac060c..5973c5be62 100644 --- a/lcl/interfaces/win32/win32winapih.inc +++ b/lcl/interfaces/win32/win32winapih.inc @@ -57,8 +57,6 @@ function CreateDIBSection(DC: HDC; const p2: tagBitmapInfo; p3: UINT; function CreateFontIndirect(Const LogFont: TLogFont): HFONT; override; function CreatePatternBrush(ABitmap: HBITMAP): HBRUSH; override; function CreatePenIndirect(Const LogPen: TLogPen): HPEN; override; -{ Creates a bitmap from raw pixmap data } -function CreatePixmapIndirect(Const Data: Pointer; Const TransColor: LongInt): HBITMAP; override; function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override; function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override; diff --git a/lcl/interfaces/wince/wincewinapi.inc b/lcl/interfaces/wince/wincewinapi.inc index 928534f3de..4078ce14ef 100644 --- a/lcl/interfaces/wince/wincewinapi.inc +++ b/lcl/interfaces/wince/wincewinapi.inc @@ -616,19 +616,6 @@ Begin Result := Windows.CreatePenIndirect(Windows.LOGPEN(LP)); End; -{------------------------------------------------------------------------------ - Method: CreatePixmapIndirect - Params: Data - Raw pixmap data - TransColor - Color of transparent spots - Returns: Handle to LCL bitmap - - Creates a bitmap from raw pixmap data. - ------------------------------------------------------------------------------} -{function TWinCEWidgetSet.CreatePixmapIndirect(const Data: Pointer; - const TransColor: Longint): HBITMAP; -begin - Result:=inherited CreatePixmapIndirect(Data, TransColor); -end;} {------------------------------------------------------------------------------ Method: CreatePolygonRgn Params: Points, NumPts, FillMode diff --git a/lcl/interfaces/wince/wincewinapih.inc b/lcl/interfaces/wince/wincewinapih.inc index a125fa257c..79d49383f4 100644 --- a/lcl/interfaces/wince/wincewinapih.inc +++ b/lcl/interfaces/wince/wincewinapih.inc @@ -76,8 +76,7 @@ function CreateFontIndirect(const LogFont: TLogFont): HFONT; override; //function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override; //function CreatePalette(const LogPalette: TLogPalette): HPALETTE; override; function CreatePenIndirect(const LogPen: TLogPen): HPEN; override; -{function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; override; -Function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; Override;} +//function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override; function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; override; {procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;}