Keith: Fixed duplicate compiler options on Win32

git-svn-id: trunk@644 -

Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2001/12/31]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/12/19]
 #
 default: all
 override PATH:=$(subst \,/,$(PATH))
@@ -156,8 +156,6 @@ override PACKAGE_VERSION=0.8a
 ifndef LCL_PLATFORM
 ifeq ($(OS_TARGET), win32)
 LCL_PLATFORM=win32
-override FPCOPT+=-dSUPPORTS_RESOURCES
-export FPCOPT
 else
 LCL_PLATFORM=gtk
 endif
@@ -1354,7 +1352,7 @@ fpc_info:
 	@$(ECHO)  Ld........ $(LD)
 	@$(ECHO)  Ar........ $(AR)
 	@$(ECHO)  Rc........ $(RC)
-	@$(ECHO)
+	@$(ECHO)  
 	@$(ECHO)  Mv........ $(MVPROG)
 	@$(ECHO)  Cp........ $(CPPROG)
 	@$(ECHO)  Rm........ $(RMPROG)
@@ -1544,7 +1542,7 @@ endif
 %.res: %.rc
 	windres -i $< -o $@
 ide:
-ifeq ($(LCL_PLATFORM), win32)
+ifeq ($(OS_TARGET), win32)
 	$(MAKE) lazarus.res
 endif
 	$(MAKE) --assume-new=lazarus.pp lazarus$(EXEEXT)
@@ -1552,10 +1550,10 @@ tools: lcl components tools_all
 all: lcl components ide
 clean: cleanall
 	$(DEL) $(wildcard ./designer/*$(OEXT))
-	$(DEL) $(wildcard ./designer/*$(PPUEXT))
+	$(wildcard ./designer/*$(PPUEXT))
-	$(DEL) $(wildcard ./debugger/*$(OEXT))
+	$(wildcard ./debugger/*$(OEXT))
-	$(DEL) $(wildcard ./debugger/*$(PPUEXT))
+	$(wildcard ./debugger/*$(PPUEXT))
-ifeq ($(LCL_PLATFORM), win32)
+ifeq ($(OS_TARGET), win32)
 	$(DEL) $(wildcard *.res)
 	$(DEL) lazarus.owr
 endif

Makefile.fpc

@@ -33,8 +33,6 @@ destdir=$(BASEDIR)/dist
 ifndef LCL_PLATFORM
 ifeq ($(OS_TARGET), win32)
 LCL_PLATFORM=win32
-override FPCOPT+=-dSUPPORTS_RESOURCES
-export FPCOPT
 else
 LCL_PLATFORM=gtk
 endif
@@ -49,7 +47,7 @@ endif
         windres -i $< -o $@
 
 ide:
-ifeq ($(LCL_PLATFORM), win32)
+ifeq ($(OS_TARGET), win32)
         $(MAKE) lazarus.res
 endif
         $(MAKE) --assume-new=lazarus.pp lazarus$(EXEEXT)
@@ -60,10 +58,10 @@ all: lcl components ide
 
 clean: cleanall
         $(DEL) $(wildcard ./designer/*$(OEXT))
-        $(DEL) $(wildcard ./designer/*$(PPUEXT))
+        $(wildcard ./designer/*$(PPUEXT))
-        $(DEL) $(wildcard ./debugger/*$(OEXT))
+        $(wildcard ./debugger/*$(OEXT))
-        $(DEL) $(wildcard ./debugger/*$(PPUEXT))
+        $(wildcard ./debugger/*$(PPUEXT))
-ifeq ($(LCL_PLATFORM), win32)
+ifeq ($(OS_TARGET), win32)
         $(DEL) $(wildcard *.res)
         $(DEL) lazarus.owr
 endif

ide/lazarus.pp

@@ -26,7 +26,7 @@ program lazarus;
 
 {$I ide.inc}
 
-{$IFDEF SUPPORTS_RESOURCES}
+{$IFDEF WIN32}
   {$R *.res}
 {$ENDIF}
 
@@ -70,6 +70,9 @@ end.
 
 {
   $Log$
+  Revision 1.27  2002/01/29 18:55:27  lazarus
+  Keith: Fixed duplicate compiler options on Win32
+
   Revision 1.26  2001/12/11 16:51:36  lazarus
   Modified the Watches dialog
   Shane

lcl/interfaces/win32/win32winapi.inc

@@ -370,9 +370,10 @@ Type
   PColorArray = ^TColorArray;
   TColorArray = Array[0..1] Of TColorMap;
   PPixmapArray = ^TPixmapArray;
-  TPixmapArray = Array[0..1] Of PChar;
+  TPixmapArray = Array[0..1000] Of PChar;
 Var
   AliasLen, BitCount, C, Planes: Cardinal;
+  AList: TList;
   Bits: PBitData;
   ColorArray: PColorArray;
   ColorCount: Integer;
@@ -386,36 +387,159 @@ Var
   PixmapInfo: TStringList;
 Const
   DC_SCREEN = 0;
+
+  Procedure NormalizeString(Var Str: String);
+  Var
+    S: String;
+  Const
+    keyTab = #9;
+  Begin
+    Assert(False, 'Trace:NormalizeString - Start');
+    Str := Replace(Str, keyTab, ' ', True);
+    S := '';
+
+    While True Do
+    Begin
+      Str := Replace(Str, '  ', ' ', True);
+      If Str = S Then
+        Break;
+      S := Str;
+    End;
+    Assert(False, 'Trace:NormalizeString - Exit');
+  End;
+
+  Function StrToInt(Const Str: String): Integer;
+  Var
+    S: String;
+  Begin
+    Assert(False, 'Trace:StrToInt - Start');
+    S := Trim(Str);
+    Result := SysUtils.StrToInt(S);
+    Assert(False, 'Trace:StrToInt - Exit');
+  End;
+
+  Function CreateColorMap: PColorArray;
+  Var
+    Elem: String;
+    I: Integer;
+    Idx: Cardinal;
+    ColorMap: TColorMap;
+  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;
+      Result := Nil;
+      Exit;
+    End;
+
+    AList := TList.Create;
+    For I := 1 To ColorCount Do
+    Begin
+      Try
+        Elem := String(PixmapArray^[I]);
+        Idx := Length(Elem) - 6;
+        With ColorMap Do
+        Begin
+          Alias := Copy(Elem, 1, AliasLen);
+          If Copy(Elem, Length(Elem) - 5, 4) <> 'None' Then
+            Color := StrToInt('$' + Copy(Elem, Idx, Length(Elem) - Idx - 1))
+          Else
+            Color := TransColor;
+          Assert(False, Format('Trace:CreateColorMap - color-map entry info --> item: %D, data: %S, alias: %S, color:0x%X', [I, String(PixmapArray^[I]), Alias, Color]));
+        End;
+        AList.Add(@ColorMap);
+      Except
+        On E: Exception Do
+          Assert(False, Format('Trace:CreateColorMap - Could not create color-map entry --> %S', [E.Message]));
+      End;
+    End;
+
+    TList(Result) := AList;
+    Assert(False, 'Trace:CreateColorMap - Exit');
+  End;
+
+  Procedure DestroyColorMap(ColorMap: PColorArray);
+  Begin
+    Assert(False, 'Trace:DestroyColorMap - Start');
+    If ColorMap <> Nil Then
+      ColorMap := Nil;
+
+    If AList <> Nil Then
+    Begin
+      AList.Free;
+      AList := Nil;
+    End;
+
+    Assert(False, 'Trace:DestroyColorMap - Exit');
+  End;
+
+  Procedure DoDrawBitmap;
+  Var
+    CX, CY: Cardinal;
+  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;
+
+    Assert(False, 'Trace:DoDrawBitmap - TODO: Draw the bitmap');
+    Assert(False, 'Trace:DoDrawBitmap - Exit');
+  End;
 Begin
   Assert(False, 'Trace:TWin32Object.CreatePixmapIndirect - Start');
+
+  Height := 0;
+  Width := 0;
+  ColorCount := 0;
+  AliasLen := 0;
+  Result := HBITMAP(Nil);
+
   PixmapArray := PPixmapArray(Data);
+  NormalizeString(String(PixmapArray^[0]));
   PixmapInfo := Split(String(PixmapArray^[0]), ' ', 3, False);
   If PixmapInfo.Count = 6 Then
     Assert(False, 'Trace:TODO: TWin32Object.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]);
-    AliasLen := StrToInt(Copy(PixmapInfo[3], 1, Length(PixMapInfo[3]) - 1));
+    Assert(False, Format('Trace: number of colors --> %D', [ColorCount]));
+    If PixmapInfo[3][Length(PixmapInfo[3])] = '"' Then
+      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:TWin32Object.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: TWin32Object.CreatePixmapIndirect - could not retrieve pixmap info --> ' + E.Message);
-      Result := HBITMAP(Nil);
-      Exit;
     End;
   End;
+
   // Temp values
   //Width := 100;
   //Height := 100;
   DC := CreateCompatibleDC(DC_SCREEN);
-  Result := CreateCompatibleBitmap(DC, Width, Height);
+  If (Width <> 0) And (Height <> 0) Then
+    Result := CreateCompatibleBitmap(DC, Width, Height);
   OldObject := SelectObject(DC, Result);
-  Assert(False, 'Trace:TODO: TWin32Object.CreatePixmapIndirect - Set the color info of the bitmap');
+  //GetMem(PixmapArray, (Width + ColorCount) * SizeOf(PChar));
-  SelectObject(DC, OldObject);
+  ColorArray := CreateColorMap;
+  DoDrawBitmap;
+  DestroyColorMap(ColorArray);
+  //FreeMem(PixmapArray);
   PixmapInfo.Free;
   PixmapInfo := Nil;
+  PixmapArray := Nil;
+  SelectObject(DC, OldObject);
   DeleteDC(DC);
   Assert(False, 'Trace:TWin32Object.CreatePixmapIndirect - Exit');
 End;
@@ -1708,6 +1832,9 @@ End;
 { =============================================================================
 
   $Log$
+  Revision 1.5  2002/01/29 18:55:27  lazarus
+  Keith: Fixed duplicate compiler options on Win32
+
   Revision 1.4  2002/01/21 09:04:30  lazarus
   Keith: Removed redef of Assert
 

lcl/interfaces/win32/winext.pas

@@ -83,6 +83,9 @@ Function GetComboBoxInfo(Const hwndCombo: HWND; pcbi: PCOMBOBOXINFO): BOOL; StdC
 { Convert string Str to a PChar }
 Function StrToPChar(Const Str: String): PChar;
 
+{ Replace OrigStr with ReplStr in Str }
+Function Replace(Const Str, OrigStr, ReplStr: String; Const Global: Boolean): String;
+
 { Creates a string list limited to Count (-1 for no limit) entries by splitting
   Str into substrings around SplitStr }
 Function Split(Const Str: String; SplitStr: String; Count: Integer; Const CaseSensitive: Boolean): TStringList;
@@ -107,6 +110,24 @@ Begin
   Result := TmpStr;
 End;
 
+Function Replace(Const Str, OrigStr, ReplStr: String; Const Global: Boolean): String;
+Var
+  InsPt: Byte;
+Begin
+  Result := Str;
+  Repeat
+    InsPt := Pos(OrigStr, Result);
+    If InsPt <> 0 Then
+    Begin
+      Delete(Result, InsPt, Length(OrigStr));
+      Insert(ReplStr, Result, InsPt);
+    End;
+
+    If Not Global Then
+      Break;
+  Until InsPt = 0;
+End;
+
 Function Split(Const Str: String; SplitStr: String; Count: Integer; Const CaseSensitive: Boolean): TStringList;
 Var
   LastP, P: Byte;
@@ -187,4 +208,4 @@ Except
     Assert(False, Format('Trace:Could not deallocate string --> %S', [E.Message]));
 End;
 
-End.
+End.